0

当尝试访问一个 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
4

1 回答 1

1

That server seems to respond quite nicely to XML requests and does not require that you move to subsequent pages for the remainder for the content.

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

You will need Microsoft XML 6.0, Microsoft HTML Object Library and Microsoft Internet Controls added to Tools, References. I'm offering this snippet as I could find no Terms of Use on that site that banned the use of robotic scrapers. Be careful that you do not get your IP banned due to repetitive scraping requests.

于 2015-02-01T18:24:14.243 回答