VBA XML V6.0 如何让它等待页面加载？

Question

我一直在努力寻找答案，但似乎找不到任何有用的东西。

基本上，我从一个网站上拉取，当您在页面上时，该网站会加载更多项目。我希望我的代码在加载完成后提取最终数据，但不确定如何让 XML httprequest 等待它。

编辑：

Sub pullsomesite()
    Dim httpRequest As XMLHTTP
    Dim DataObj As New MSForms.DataObject
    Set httpRequest = New XMLHTTP
    Dim URL As String
    URL = "somesite"
     With httpRequest
        .Open "GET", URL, True
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        Application.Wait Now + TimeValue("0:02:00")
        .send
        ' ... after the .send call finishes, you can check the server's response:
    End With
    While Not httpRequest.readyState = 4            '<---------- wait
Wend
 If httpRequest.Status = 200 Then
 Application.Wait Now + TimeValue("0:00:30")
    Debug.Print httpRequest.responseText
    'continue...
End If
    'Debug.Print httpRequest.Status
    'Debug.Print httpRequest.readyState
    'Debug.Print httpRequest.statusText
    DataObj.SetText httpRequest.responseText
    DataObj.PutInClipboard

    With Sheets("Sheet1")
        .Activate
        .Range("A1000000").End(xlUp).Offset(1, 0).Select
        .PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    End With
End Sub

截屏

Answer 1

尝试等待响应的就绪状态和正文不包含“更新”一词：

Option Explicit

Sub pullSomeSite()
    Dim httpRequest As XMLHTTP
    Set httpRequest = New XMLHTTP
    Dim URL As String

    URL = "SomeSite"
    With httpRequest
        .Open "GET", URL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
    End With
    With httpRequest
        While Not .ReadyState = 4                               '<---------- wait
            Application.Wait Now + TimeValue("0:00:01")
        Wend
        If .Status = 200 Then
            While InStr(1, .responseText, "Updating", 0) > 0    '<---------- wait again
                Application.Wait Now + TimeValue("0:00:01")
            Wend
            Debug.Print .responseText
            'continue...
        End If
    End With
End Sub