在 for 循环中进行 Webscrape - 跟进

Question

在我上一个问题Webscrape VBA with condition 之后，我开始尝试自动执行我在excel 文档中准备的来自该网站here 的url 列表的过程。当我尝试使用 20 和 30 url 时，它工作得很好，但是当我增加它时，GetNodesTextAsArray 中的 ReDim 出现“脚本超出范围错误”，你知道为什么吗？ 经过一番研究，我尝试用 for 循环替换它，但它没有改变任何东西。

Public Sub WindInfo()
'VBE> Tools > References:
'1. Microsoft, XML v6
'2. Microsoft HTML Object Library
'3. Microsoft Scripting Runtime
Dim xhr As MSXML2.XMLHTTP60: Set xhr = New MSXML2.XMLHTTP60
Dim html As MSHTML.HTMLDocument: Set html = New MSHTML.HTMLDocument
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim url As String
Dim j As Integer
Dim r As Long


r = 1

For j = 1 To 20

url = Worksheets("List").Cells(j, 1).Value

    With xhr
        .Open "GET", url, False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim generalities As Object, arrGen(), partsList As Object
    
    

    Set generalities = html.querySelectorAll("#bloc_texte table ~ table li")
    arrGen = GetNodesTextAsArray(generalities)
    
    Dim parts As Object, numberOfParts As Long
    
    Set partsList = html.querySelectorAll("h1 ~ h3, ul ~ h3")
    
    
    If partsList.Length > 0 Then
    
        numberOfParts = html.querySelectorAll("h1 ~ h3, ul ~ h3").Length / 2
    
        Set parts = html.querySelectorAll("h3 + ul")
       
        Dim i As Long, liNodes As Object, arr()
        Dim html2 As MSHTML.HTMLDocument: Set html2 = New MSHTML.HTMLDocument
        
        For i = 0 To numberOfParts - 1
            ws.Cells(r, 1).Resize(1, UBound(arrGen)) = arrGen
            html2.body.innerHTML = parts.Item(i).outerHTML & parts.Item(i + numberOfParts).outerHTML
            Set liNodes = html2.querySelectorAll("li")
            arr = GetNodesTextAsArray(liNodes)
            ws.Cells(r, 5).Resize(1, UBound(arr)) = arr
            r = r + 1
        Next
        
    Else
        arr = GetNodesTextAsArray(html.querySelectorAll("#bloc_texte h1 + ul").Item(1).getElementsByTagName("li"))
        ws.Cells(r, 1).Resize(1, UBound(arrGen)) = arrGen
        ws.Cells(r, 5).Resize(1, UBound(arr)) = arr
        r = r + 1
    End If
    Application.Wait (Now + TimeValue("0:00:01"))
Next

End Sub


Public Function GetNodesTextAsArray(ByVal nodeList As Object) As Variant()
Dim i As Long, results()

ReDim results(1 To nodeList.Length)

   

For i = 0 To nodeList.Length - 1
    results(i + 1) = nodeList.Item(i).innerText
Next i
GetNodesTextAsArray = results
End Function

Answer 1

9/10 VBA 网页抓取的问题与页面加载有关。

因此，您要做的是尝试在页面加载时循环的错误处理程序，然后测试该元素是否出现在页面上。

我会把代码留给你，但这里的时间基本上是一切，因为即使是状态代码检查和等待文档加载检查，也不能保证你需要的所有内容都已加载。

即使使用 selenium 和 puppeteer 等出色的工具，您仍然需要检查/处理元素加载和计时，并且不能只是假设，因为文档已加载，元素就在那里。

有意义吗？