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]

Haluk, please be aware of what yousufj56 has posted here

Mark, thank you for this info.

Thanks Haluk. Can we instead do this using:
For x = 1 To Application.CountA(Sheet2.Columns(1)) On Error Resume Next
URL = Sheet2.Cells(x, 1)


That was much easier to work with last time because i can put a list of URLs in sheet2.

Hey, in the earlier macros, you had listed the data points. Data-0, Data-1 etc.

Can we add it to this one too? I need to be able to tell which URL each data set belongs too. Every time its Data-0, its a new data set.

yousufj56;

I don't remember that I have replied to these questions .... so why are you asking the same question in a new thread within a short time, without referring with a link to this one.

And; although Macropod has warned you for cross-posting outside this forum, you have not still mentioned this thread in the other forum as well as your cross-posted link inside this forum, mentioned by MARK858

This is not a polite behaviour.......

Please remember that; posting questions on forums like this is a serious thing because, people are spending their time on replying the threads where time is a valuable thing nowadays.

Having said this and hoping you are going to correct your cross-posted messages inside and outside this forum, try the following code;

Sub Test10()
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim x As Integer, NoB As Integer, NoD As Integer
    Dim myData As Object
    
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    Sheets(1).Cells.Clear
    Sheets(1).Range("A1:E2").Font.Bold = True
    Sheets(1).Range("A1:E2").Font.Color = vbRed
    Sheets(1).Range("B1") = "Buy"
    Sheets(1).Range("B2") = "Quantity"
    Sheets(1).Range("C2") = "Rate"
    Sheets(1).Range("D1") = "Sell"
    Sheets(1).Range("D2") = "Quantity"
    Sheets(1).Range("E2") = "Rate"
    
    For x = 1 To Application.CountA(Sheet2.Columns(1))
        URL = Sheets(2).Cells(x, 1)
        objHTTP.Open "GET", URL, False
        objHTTP.Send
        
        If objHTTP.ReadyState = 4 Then
            If objHTTP.Status = 200 Then
            
                Set RetVal = MyScript.Eval("(" & objHTTP.responseText & ")")
                objHTTP.abort
                
                Set MyList1 = RetVal.result.buy
                NoB = Sheet1.Cells(65536, 2).End(xlUp).Row + 1
                Sheets(1).Cells(NoB, 1) = URL
                Cells(NoB, 1).Font.Color = vbBlue
                Cells(NoB, 1).Font.Bold = True
            
                i = 0
                NoB = NoB + 1
                For Each myData In MyList1
                    Sheets(1).Cells(NoB, 1).Value = "Data-" & i
                    Sheets(1).Cells(NoB, 2).Value = myData.Quantity
                    Sheets(1).Cells(NoB, 3).Value = myData.Rate
                    NoB = NoB + 1
                    i = i + 1
                Next
                
                Set MyList2 = RetVal.result.sell
                NoD = Sheet1.Cells(65536, 4).End(xlUp).Row + 1
                Sheets(1).Cells(NoD, 1).Value = URL
                Cells(NoD, 1).Font.Color = vbBlue
                Cells(NoD, 1).Font.Bold = True
                NoD = NoD + 1
                i = 0
                
                For Each myData In MyList2
                    Sheets(1).Cells(NoD, 1).Value = "Data-" & i
                    Sheets(1).Cells(NoD, 3).Value = myData.Quantity
                    Sheets(1).Cells(NoD, 4).Value = myData.Rate
                    NoD = NoD + 1
                    i = i + 1
                Next
            End If
        End If
    Next
    
    MsgBox "All data is retrived..."
    
    Set MyList2 = Nothing
    Set MyList = Nothing
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub

 

[yousufj56]

Thanks Haluk, it worked. And sorry for the cross posts. I have now added a link to those posts and told them it has been resolved. Sorry, I originally didnt want to ask you again because you already helped me so many times. But when i noticed no one was able to answer, i re-asked. Won't happen again.

 

[yousufj56]

Hi Haluk,

New issue. For the code below which you provided me, how can I use the JSON structure from this URL on query. I just need the list of bids and the list of asks: https://www.binance.com/api/v1/depth?symbol=TRXBTC&limit=1000

Sub ORDERS()
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim x As Integer, NoA As Integer, NoC As Integer
    Dim myData As Object
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    
    
    For x = 1 To Application.CountA(Sheet2.Columns(1))
        Sheets("Sheet1").Activate
        Sheets(1).Cells.Clear
        Sheets(1).Range("A1:D2").Font.Bold = True
        Sheets(1).Range("A1:D2").Font.Color = vbRed
        Sheets(1).Range("A1") = "Buy"
        Sheets(1).Range("A2") = "Quantity"
        Sheets(1).Range("B2") = "Rate"
        Sheets(1).Range("C1") = "Sell"
        Sheets(1).Range("C2") = "Quantity"
        Sheets(1).Range("D2") = "Rate"
        
        URL = Sheets(2).Cells(x, 1)
        objHTTP.Open "GET", URL, False
        objHTTP.Send
        
        If objHTTP.ReadyState = 4 Then
            If objHTTP.Status = 200 Then
            
                Set RetVal = MyScript.Eval("(" & objHTTP.responseText & ")")
                objHTTP.abort
                
                Set MyList1 = RetVal.result.buy
                NoA = Sheet1.Cells(65536, 1).End(xlUp).Row + 1
                
                For Each myData In MyList1
                    Sheets(1).Cells(NoA, 1).Value = myData.Quantity
                    Sheets(1).Cells(NoA, 2).Value = myData.Rate
                    NoA = NoA + 1
                Next
                
                Set MyList2 = RetVal.result.sell
                
                NoC = Sheet1.Cells(65536, 3).End(xlUp).Row + 1
                
                For Each myData In MyList2
                    Sheets(1).Cells(NoC, 3).Value = myData.Quantity
                    Sheets(1).Cells(NoC, 4).Value = myData.Rate
                    NoC = NoC + 1
                Next
            End If
        End If
    
    Call Macro1
    Call Macro3
    Call Macro2
        
    Next
    
       
    Set MyList2 = Nothing
    Set MyList = Nothing
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub

 

[Haluk]

Hi again;

I have provided a lot of codes related with getting data from various JSon tables.

If you need more assistance, you can send a private message to me.

 

[knitin28289]

Hi,
This below code is helpful to get the data from json. but I am getting error at line "Set MyList = RetVal.Data" . The error is 'Object doesn't support this property or method'.

Note : I am able to extract all data from URL into object Retval when I can see all the details in Watches.

Please help me in this. Do I need to add any references for this or need to create a specific object for this.

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

 

[sambills]

Hey Haluk,

Sorry to bother you again. The macro is working great but now i need it a little different.
bitcoin futures basis trading lesson 1

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

it works good now