Search code examples
excelxmlvbaxmlhttprequest

VBA XML V6.0 How to make it wait for page to load?


I have been pulling my hair out trying to find an answer for this and I cant seem to find anything useful.

Basically I am pulling from a website that loads more items on it while you are on the page. I would like my code to pull the final data after its done loading but am not sure how to make XML httprequest wait for that.

Edited:

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

Screenshot

Screenshot


Solution

  • Try waiting for the ready state and body of the response not to contain the word "Updating":

    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