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

【问题标题】：VBA XML V6.0 How to make it wait for page to load?VBA XML V6.0 如何让它等待页面加载？
【发布时间】：2015-11-28 08:23:46
【问题描述】：

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

基本上，当您在页面上时，我会从一个加载更多项目的网站中提取。我希望我的代码在加载完成后提取最终数据，但不知道如何让 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

截图

【问题讨论】：

这是什么意思：当您在页面上时会在其上加载更多项目的页面 ??
所以当我用浏览器访问这个网站时，它会打开一个标题并一次加载一个部分。我需要所有这些部分。它是一个公司网站，所以很遗憾，我不能仅仅分享它以使其更容易解释。
“一次一个部分”是什么意思？这是自动加载的吗？还是像 ajax/javascript 动态加载（即，当您向下滚动页面时，它会加载更多项目）
如果它不是动态的，您可能需要检查 .readyState = 4。
@DavidZemens .readyState 对于同步 XHR 始终为 4，就像上面的代码一样 @Forbidden 您的网站显然使用动态负载，您可以尝试找出动态 XHR 参数，例如在 Chrome 中我在开发人员中看到它们网络选项卡上的工具 (F12)，然后在您的代码中使用该参数。

标签： excel xml vba xmlhttprequest

【解决方案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

【讨论】：

在这种情况下，.ReadyState = 4 条件总是返回 true，因此循环将被跳过，因为您在第三个参数中设置了同步模式：.Open "GET", URL, False。
您想说您将请求更新为 A同步 :) 为什么呢？离开 XHR 同步呈现不必要的.ReadyState 检查。
非常感谢您的尝试，但它仍然会拉出带有“正在更新”的部分数据的页面。我试图弄清楚如何找到像@omegastripes 所说的 XHR 参数。
如果您无法让参数起作用，请尝试等待响应正文中不包含“正在更新”一词（不考虑部分）
在等待期间我应该放在哪里？发送之前？

【解决方案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

【讨论】：