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

Answer 2

对@paul bica的答案进行了轻微的修改，希望将来可以对任何人有所帮助。

对我来说，我只想尝试20次，然后放弃并继续执行代码的其他部分。

Option Explicit
    
Sub pullSomeSite()
    Dim httpRequest As XMLHTTP
    Set httpRequest = New XMLHTTP
    Dim URL As String
    
    Dim count_try As Long
    count_try = 1

    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
                If count_try < 20 Then ' Set the amount of tries before giving up
                    Application.Wait Now + TimeValue("0:00:01")
                    count_try = count_try + 1 'For each try, increase with 1
                Else
                    'If more than 20 attempts where made, jump to this part of the code to continue (not get stuck in infinity loop)
                    GoTo ContinTry
                End IF
            Wend
            Debug.Print .responseText
            'continue...
        End If
    End With

ContinTry:      
'Code to handle the error for example:
Cells(1,1).Value = "Request Failed"
End Sub