0

URL にアクセスしようとすると、コードが readystate ループでスタックし、読み込まれません。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
4

1 に答える 1

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 が禁止されないように注意してください。

于 2015-02-01T18:24:14.243 に答える