在 VBA 网络抓取期间，IE Readystate 停留在 1

Question

当试图达到 URL 时，我的代码卡在我的就绪状态循环中并且永远不会加载。就绪状态永久保持在 1。如果我暂停代码并点击调试，光标会以一种奇怪的顺序跳过我的程序，有时跳到结尾然后跳到开头，有时又回到子程序的开头。

我了解到这可能是 javascript 的问题，但我似乎找不到任何解决方案。

有没有办法让它工作？

Sub Navigate()

    IE.Visible = True
    IE.Navigate ("http://web.vermont.org/Accounting?ysort=true")

    Do While IE.ReadyState <> 4
           DoEvents
    Loop


    Set Doc = IE.Document

End Sub

Answer 1

该服务器似乎可以很好地响应 XML 请求，并且不需要您转到后续页面以获取剩余内容。

Sub Get_Listings()
    Dim sURL As String, iDIV As Long, htmlBDY As HTMLDocument, xmlHTTP As MSXML2.ServerXMLHTTP60

    Set xmlHTTP = New MSXML2.ServerXMLHTTP60
    Set htmlBDY = New HTMLDocument

    'sURL = "http://web.vermont.org/Accounting?ysort=true"
    sURL = "http://web.vermont.org/Dining?ysort=true"


    With xmlHTTP
        .Open "GET", sURL, False
        .setRequestHeader "Content-Type", "text/xml"
        .send
        Do While .readyState <> READYSTATE_COMPLETE: DoEvents: Loop
        If .Status <> 200 Then GoTo CleanUp
        htmlBDY.body.innerHTML = .responseText
    End With

    With htmlBDY
        For iDIV = 0 To (.getElementsByclassname("ListingResults_All_ENTRYTITLELEFTBOX").Length - 1)
            If CBool(.getElementsByclassname("ListingResults_All_ENTRYTITLELEFTBOX")(iDIV).getElementsByTagName("a").Length) Then
                Debug.Print _
                  .getElementsByclassname("ListingResults_All_ENTRYTITLELEFTBOX")(iDIV).getElementsByTagName("a")(0).innertext
            End If
        Next iDIV
    End With

CleanUp:
    Set htmlBDY = Nothing
    Set xmlHTTP = Nothing
End Sub

您需要将 Microsoft XML 6.0、Microsoft HTML 对象库和 Microsoft Internet 控件添加到“工具”、“参考”中。我提供这个片段是因为我在那个网站上找不到禁止使用机器人刮板的使用条款。请注意不要因为重复的抓取请求而禁止您的 IP。

在 VBA 网络抓取期间，IE Readystate 停留在 1

IE Readystate stuck at 1 during VBA webscraping

vba

readystate

web-scraping