CODEWITHSUNDEEP
excelvbaapiweb-scraping
polo31
polo31

Reputation: 43

GET request data doesn't update

I'm trying to retrieve data from an API but my variable doesn't update even if I set it as nothing before the GET request.

The data of the variable update only if I close Excel and re-open it.

Is there any explanation for it? I've been scratching my head for so long.

Here is the code

Sub getJsonResult()
    Dim objRequestt As Object
    Dim strUrl As String
    Dim blnAsync As Boolean
    Dim strUrlXBTUSD As String
    Dim strResponse As String
    Dim jsonText As String
    Dim jsonObject As Object, item As Object
    Dim i As Integer

    'setting up the variable to 0 or nothing

    strUrlXBTUSD = ""
    strResponsee = ""
    jsonText = ""
    i = 0
 blnAsync = False
 Set item = Nothing
 Set jsonObject = Nothing
 Set objRequestt = Nothing
 Set objRequestt = CreateObject("MSXML2.XMLHTTP")
    strUrlXBTUSD = "https://www.bitmex.com/api/v1/orderBook/L2?symbol=XBTUSD&depth=3"
    blnAsync = True


    'Starting the GET request

    ThisWorkbook.Activate
    With objRequestt
        .Open "GET", strUrlXBTUSD, blnAsync
        .SetRequestHeader "Content-Type", "application/json"
        .send
        strResponse = .responseText 'here the response is always the same except if i Close Excel
           Debug.Print strResponsee
    End With
End Sub

At the end "strResponse" is always the same even after several F5 refresh. I can see that the data are no longer accurate on a web browser. I'd like the VBA program to get accurate data and refresh without closing Excel.

How to do that?

Upvotes: 2

Views: 1970

Answers (2)

QHarr
QHarr

Reputation: 84475

You can add an instruction to avoid being served cached results (server can ignore this but I have had good success with this in the past). Make sure your async argument is always False and leave more time between tests. I notice that sometimes the prices are slow to change so you may miss the change due to too small an interval/not enough attempts. You will notice the size change though. You should add a max timeout to the loop in the bottom script.

Also removed the hungarian notation.

Option Explicit

Public Sub getJsonResult()
    Dim http As Object
    Dim urlXBTUSD As String
    Dim response As String
    Dim j As Long
    Const ASYNC_ARG As Boolean = False

    Set http  = CreateObject("MSXML2.XMLHTTP")
    For j = 1 To 10
        response = vbNullString
        urlXBTUSD = "https://www.bitmex.com/api/v1/orderBook/L2?symbol=XBTUSD&depth=3"

        With http 
            .Open "GET", urlXBTUSD,  ASYNC_ARG
            .setRequestHeader "Content-Type", "application/json"
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            response = .responseText
            Debug.Print response
        End With
        Application.Wait Now + TimeSerial(0, 0, 15)
    Next
End Sub

Here is a long and tedious way of proving it by looping until price of first item in return collection changes. I use jsonconverter.bas added to project and VBE > Tools > References > Microsoft Scripting Runtime reference.

Option Explicit

Public Sub getJsonResult()
    Dim http  As Object
    Dim urlXBTUSD As String
    Dim response As String
    Dim j As Long
    Const ASYNC_ARG As Boolean = False
    Dim price As String, firstValue As String

    Set http  = CreateObject("MSXML2.XMLHTTP")
    urlXBTUSD = "https://www.bitmex.com/api/v1/orderBook/L2?symbol=XBTUSD&depth=3"

    With http 
        .Open "GET", urlXBTUSD,  ASYNC_ARG
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
         firstValue = JsonConverter.ParseJson(.responseText)(1)("price")
        Debug.Print  firstValue
        Do
            .Open "GET", urlXBTUSD, blnAsync
            .setRequestHeader "Content-Type", "application/json"
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            price = JsonConverter.ParseJson(.responseText)(1)("price")
            Application.Wait Now + TimeSerial(0, 0, 5)
        Loop While price = firstValue
        Debug.Print price
    End With
End Sub

Upvotes: 2

Noodles
Noodles

Reputation: 194

This is for diagnostic purposes.

On Error Resume Next
Set File = WScript.CreateObject("Msxml2.XMLHTTP.6.0")
File.Open "GET", "https://www.google.com.au/search?q=cat", False
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send

wscript.echo "==================" 
    wscript.echo "" 
    wscript.echo "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
    wscript.echo "Source " & err.source 
    wscript.echo "" 
    wscript.echo "Server Response " & File.Status & " " & File.StatusText
    wscript.echo    File.getAllResponseHeaders
    wscript.echo    File.ResponseBody

Upvotes: 0

Related Questions