Reputation: 45
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
Upvotes: 2
Views: 11047
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
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