Question

尝试访问网址时，我的代码卡在我的readystate循环中，从不加载。状态状态永久保持为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 Object Library和Microsoft Internet Controls。我提供这个片段，因为我在该网站上没有发现禁止使用机器人刮刀的使用条款。请注意，由于重复的抓取请求，您不会被禁止使用IP。

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

1 个答案: