Forbidden
Forbidden

Reputation: 45

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

Upvotes: 2

Views: 11047

Answers (2)

Wizhi
Wizhi

Reputation: 6549

A slight modification to @paul bica's answer, which hopefully can help anyone in the future.

For me I just wanted to make 20 attempts, then give up and continue with other parts of the code.

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

Upvotes: 0

paul bica
paul bica

Reputation: 10715

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

Upvotes: 6

Related Questions