VBA Macro to extract JSON data and post into cells

[yousufj56]

Hi,

I'm thinking that the error is because the url is an HTTPS? I'm getting mismatch type error.

I'm trying to getting the JSON data from this URL: https://min-api.cryptocompare.com/data/price?fsym=ETH&tsyms=USD

This is the code i'm using:

Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://min-api.cryptocompare.com/data/price?fsym=ETH&tsyms=USD", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item("USD")


i = i + 1
Next
MsgBox ("complete")
End Sub

 

[Haluk]

Try this;

Sub Test()
    Dim objHTTP As Object
    Dim MyScript As Object

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    URL = "https://min-api.cryptocompare.com/data/price?fsym=ETH&tsyms=USD"
    
    objHTTP.Open "GET", URL, False
    objHTTP.send
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    
    Set RetVal = MyScript.Eval("(" + objHTTP.responsetext + ")")
    MsgBox RetVal.USD
End Sub

 

[yousufj56]

Hey, Thanks for the reply. That does work. But can you show me how i can actually paste it to a cell instead of the msg box?

 

[Haluk]

If you want the data to be in cell A1, instead of the following line;

MsgBox RetVal.USD

you can use;

Range("A1") = RetVal.USD

 

[yousufj56]

Thanks that works. So now im trying to apply the same thing to a different URL. But its not working You think you can take a look please?

This is the url: https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG

I'm trying to get close and volumeto values.

Also, do you know how i would put a range of URLs in sheet2 for the macro to loop through and get the desired values for all?

Thanks again for all your help

 

[Haluk]

The keyword "Close" is a reserved word in Excel so it creates a problem in the code.

Instead of it; "volumefrom" and "volumeto" values can be fetched with the following code;
(Format the columns A and B as "number" if needed)

Sub Test4()
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim i As Long
    Dim myData As Object
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"

    
    URL = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.send
    
    Set RetVal = MyScript.Eval("(" + objHTTP.responsetext + ")")
    objHTTP.abort
    
    i = 2
    
    Set MyList = RetVal.Data
    
    For Each myData In MyList
        Cells(i, 1).Value = myData.volumefrom
        Cells(i, 2).Value = myData.volumeto
        i = i + 1
    Next
    
    Set MyList = Nothing
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub

 

[yousufj56]

Nice that worked. What if i just wanted the second line from the JSON file?

 

[Haluk]

Try this;

Sub Test5()
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim i As Long
    Dim myData As Object
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"

    
    URL = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.send
    
    Set RetVal = MyScript.Eval("(" + objHTTP.responsetext + ")")
    objHTTP.abort
    
    i = 2
    
    Set MyList = RetVal.Data
    
    x = 0
    For Each myData In MyList
        x = x + 1
        If x = 1 Then                                'Get values from the second data
            Cells(i, 1).Value = myData.volumefrom
            Cells(i, 2).Value = myData.volumeto
        i = i + 1
        Exit For
        End If
    Next
    
    Set MyList = Nothing
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub

 

[yousufj56]

Amazing, works perfect.

Lastly, instead of defining a URL in the code here, can i ask VBA to refer to a range of urls in sheet2 and loop and get values from each url listed?

Thank you so much for helping me with this!!

 

[Haluk]

As I mentioned in my post (No:4) the related JSon property "Close" is a reserved name/key for Excel, so it cannot be fetched from the JSon table with the style of coding in message No:4

But, this is not the end of Excel .... we can still get the value of the property "close" in the JSon items by using a small but very effective JavaScript function which I have prepared. This can be added to the Excel VBA code and in this way we can fetch an item's "close" property and get the value.

The code is;

Sub Test6()
    'Haluk
    '11/12/2017
    
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData
    
    URL = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"
    
    'The returned JSon table contents have the primary key/label named as "Data"
    'We are going to refer this "Data" in the following JScript
    
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.Send
    
    Set RetVal = MyScript.Eval("(" & objHTTP.responseText & ")")
    objHTTP.abort
    
    'Retrieve the value of the key "close" in the 4th item of the data set "Data"
    'with the help of the JScript function "getValue" above
    
    myData = MyScript.Run("getValue", RetVal, 4, "close")
    Range("B1") = myData
    MsgBox myData
    
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub