VBA Macro to extract JSON data and post into cells

Y

yousufj56

Board Regular
Joined
May 22, 2014
Messages
51
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:
Code: 
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
 
Sort by date Sort by votes
With the help of the JScript in my last post above and a new one in the below code, all the values of the keys can be retrieved successfully.

The code is;
Code: 
Sub Test7()
    'Haluk
    '11/12/2017
    
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData As Variant
    Dim myLength As Byte
    
    'Clean the sheet
    
    ActiveSheet.Cells.Clear

    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 two JScripts "getValue" and "getLength"
    
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
    MyScript.AddCode "function getLength(JSonList) { return JSonList.Data.length; }"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.Send
    
    'Get the JSon table
    
    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")
    MsgBox "This is a small demo...." & vbCrLf & vbCrLf _
    & "Value of the key 'close' of the 4th data in the JSON table is: " & myData
    
    'Get the count of items in the JSon table under "Data"
    
    myLength = MyScript.Run("getLength", RetVal)
    
    'Write labels of the key in the table to the sheet
    
    Range("B1") = "time"
    Range("C1") = "close"
    Range("D1") = "high"
    Range("E1") = "low"
    Range("F1") = "open"
    Range("G1") = "volumefrom"
    Range("H1") = "volumeto"
    Range("J1") = "TimeFrom:"
    Range("J2") = "TimeTo:"
    Range("B1:H1, J1:J2").Font.Bold = True
    Range("B1:H1, J1:J2").Font.Color = vbRed
    
    'Get all the values of the JSon table under "Data"
    
    For i = 0 To myLength - 1
        Range("A" & i + 2) = "Data -" & i
        Range("B" & i + 2) = MyScript.Run("getValue", RetVal, i, "time") / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
        Range("C" & i + 2) = MyScript.Run("getValue", RetVal, i, "close")
        Range("D" & i + 2) = MyScript.Run("getValue", RetVal, i, "high")
        Range("E" & i + 2) = MyScript.Run("getValue", RetVal, i, "low")
        Range("F" & i + 2) = MyScript.Run("getValue", RetVal, i, "open")
        Range("G" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumefrom")
        Range("H" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumeto")
    Next
    
    'Get the time info given in the JSon table
    
    Range("K1") = RetVal.TimeFrom / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    Range("K2") = RetVal.TimeTo / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub
 
Last edited:
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Hey, I just tried that, but i dont think that its doing what i expected. Can you advise?

Basically what im trying to is this:

Current: URL = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"

Desired: URL = ThisWorkbook.Sheets("Sheet2").Range("A:A")


But i'm trying to get the entire code to loop for all URLs in range.
 
Upvote 0
My posts in messages No:10 and 11 are related to get datas from the JSon table and nothing to do with looping URL's on the sheet cells.
You can construct a simple For-Next loop for that.
 
Upvote 0
Haluk, please help!! :(

I've been trying to figure out the for next loop for a few hours and i just can't get it. I'm getting close but it just keeps giving me errors.
 
Upvote 0
Haluk, I got a working result of the loop. But the data is being overwritten everytime it loops. How can i avoid this?

Code: 
Sub Test7()
    'Haluk
    '11/12/2017
    
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData As Variant
    Dim myLength As Integer


    'Clean the sheet
    
    ActiveSheet.Cells.Clear
    
    For x = 1 To Application.CountA(Sheet2.Columns(1))
    
    URL = Sheet2.Cells(x, 1)
    
    'The returned JSon table contents have the primary key/label named as "Data"
    'We are going to refer this "Data" in the following two JScripts "getValue" and "getLength"
    
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
    MyScript.AddCode "function getLength(JSonList) { return JSonList.Data.length; }"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.Send
    
    'Get the JSon table
    
    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")
    
     
    myLength = MyScript.Run("getLength", RetVal)
    
    'Write labels of the key in the table to the sheet
    
    Sheet1.Range("B1") = "time"
    Sheet1.Range("C1") = "close"
    Sheet1.Range("D1") = "high"
    Sheet1.Range("E1") = "low"
    Sheet1.Range("F1") = "open"
    Sheet1.Range("G1") = "volumefrom"
    Sheet1.Range("H1") = "volumeto"
    Sheet1.Range("J1") = "TimeFrom:"
    Sheet1.Range("J2") = "TimeTo:"
    Sheet1.Range("B1:H1, J1:J2").Font.Bold = True
    Sheet1.Range("B1:H1, J1:J2").Font.Color = vbRed
    
    'Get all the values of the JSon table under "Data"
    
    For i = 0 To myLength - 1
        Sheet1.Range("A" & i + 2) = "Data -" & i
        Sheet1.Range("B" & i + 2) = MyScript.Run("getValue", RetVal, i, "time") / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
        Sheet1.Range("C" & i + 2) = MyScript.Run("getValue", RetVal, i, "close")
        Sheet1.Range("D" & i + 2) = MyScript.Run("getValue", RetVal, i, "high")
        Sheet1.Range("E" & i + 2) = MyScript.Run("getValue", RetVal, i, "low")
        Sheet1.Range("F" & i + 2) = MyScript.Run("getValue", RetVal, i, "open")
        Sheet1.Range("G" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumefrom")
        Sheet1.Range("H" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumeto")
    Next
    
    'Get the time info given in the JSon table
    
    Sheet1.Range("K1") = RetVal.TimeFrom / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    Sheet1.Range("K2") = RetVal.TimeTo / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    
    Set objHTTP = Nothing
    Set MyScript = Nothing
    
    Next
End Sub
 
Upvote 0
If the JSon tables in the URL's have the same structure exactly, you can try the following code;

Code: 
Sub Test8()
    'Haluk
    '12/12/2017
    
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData As Variant
    Dim myLength As Integer
    Dim NoA As Long

    'Clean the sheet
    Sheet1.Cells.Clear
    Sheet1.Activate
    
    'Write labels of the key in the table to the sheet
    Sheet1.Range("B1") = "time"
    Sheet1.Range("C1") = "close"
    Sheet1.Range("D1") = "high"
    Sheet1.Range("E1") = "low"
    Sheet1.Range("F1") = "open"
    Sheet1.Range("G1") = "volumefrom"
    Sheet1.Range("H1") = "volumeto"
    Sheet1.Range("B1:H1, J1:J2").Font.Bold = True
    Sheet1.Range("B1:H1, J1:J2").Font.Color = vbRed
    
    'The returned JSon table contents have the primary key/label named as "Data"
    'We are going to refer this "Data" in the following two JScripts "getValue" and "getLength"
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
    MyScript.AddCode "function getLength(JSonList) { return JSonList.Data.length; }"
    
    For x = 1 To Application.CountA(Sheet2.Columns(1))
        URL = Sheet2.Cells(x, 1)
        
        Set objHTTP = CreateObject("MSXML2.XMLHTTP")
        objHTTP.Open "GET", URL, False
        objHTTP.Send
        
        'Get the JSon table
        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")
        myLength = MyScript.Run("getLength", RetVal)
        
        'Get all the values of the JSon table under "Data"
        For i = 0 To myLength - 1
            NoA = Sheet1.Cells(65536, 1).End(xlUp).Row + 1
            Sheet1.Range("A" & NoA) = "Data -" & i
            Sheet1.Range("B" & NoA) = MyScript.Run("getValue", RetVal, i, "time") / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
            Sheet1.Range("C" & NoA) = MyScript.Run("getValue", RetVal, i, "close")
            Sheet1.Range("D" & NoA) = MyScript.Run("getValue", RetVal, i, "high")
            Sheet1.Range("E" & NoA) = MyScript.Run("getValue", RetVal, i, "low")
            Sheet1.Range("F" & NoA) = MyScript.Run("getValue", RetVal, i, "open")
            Sheet1.Range("G" & NoA) = MyScript.Run("getValue", RetVal, i, "volumefrom")
            Sheet1.Range("H" & NoA) = MyScript.Run("getValue", RetVal, i, "volumeto")
        Next
        'Get the time info given in the JSon table
        Sheet1.Range("J" & NoA) = "TimeFrom:"
        Sheet1.Range("J" & NoA + 1) = "TimeTo:"
        Sheet1.Range("K" & NoA) = RetVal.TimeFrom / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
        Sheet1.Range("K" & NoA + 1) = RetVal.TimeTo / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    Next
    
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub
 
Last edited:
Upvote 0
Thanks Haluk! Youre the best!! It worked The data sets are really large so excel keeps freezing but i just had to make the data set smaller in order to run it.
 
Upvote 0
Hey Haluk,

Sorry to bother you again. The macro is working great but now i need it a little different.
https://bittrex.com/api/v1.1/public/getorderbook?market=BTC-LTC&type=both

The above URL has a set of buy orders and a set of sell orders.

I want to extract that data into excel, but i want it to be lumped all together. eg. Maybe have a header that says Buy or a header that says Sell.

Your help is appreciated!

Thanks,

Yousuf
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
How to parse Json data from webpage to excel sheet ?
Replies
4
Views
3K
ppnar007
P
E
  • Solved
Deleting contents of Json object in VBA
Replies
5
Views
242
Edsancar
E
M
  • Question Question
Send POST request data using VBA
Replies
0
Views
847
mwl707
M
L
  • Question Question
Can I use VBA to pull data from the web that requires bearer token authentication and also can I automatically convert the .json data to .xml?
Replies
4
Views
4K
lala_Hae_dong
L
R
  • Question Question
Having Trouble getting this code in VBA to work. Attempting to download a list of PDFs
Replies
1
Views
125
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top