Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Parsing Json array via VBA

Tags:

macos

excel

vba

I am getting a json response from an api and parse it to update in excel. Below is the code. I am not able to parse further to get the price info.

Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://bitbns.com/order/getTickerAll"
objHTTP.Open "GET", URL, False
objHTTP.Send
Set JSON = JsonConverter.ParseJson(objHTTP.ResponseText)
'strResult = objHTTP.ResponseText
'MsgBox JSON(1)("BTC")("sellPrice")
baseCol = 9
buyCol = 10
sellCol = 11
i = 1
Dim keyCurr As String
For Each Item In JSON
    ActiveSheet.Cells(i + 2, baseCol).Value = Item.Keys
    i = i + 1
Next

Kinly help. As you could see in a comment above, I am able to get data as hard coded

MsgBox JSON(1)("BTC")("sellPrice")

But when I try getting that in loop, I am unable to. Below are the ones I tried but did not work.

ActiveSheet.Cells(i + 2, baseCol).Value = JSON(i)(Item.Keys)("sellPrice") 
ActiveSheet.Cells(i + 2, baseCol).Value = JSON(i)(" + Item.Keys + ")("sellPrice")
ActiveSheet.Cells(i + 2, baseCol).Value = JSON(i)(Item(0))("sellPrice")
ActiveSheet.Cells(i + 2, baseCol).Value = JSON(i)(Item(1))("sellPrice")

For parsing JSON, I use vbaJSON library. It seem to return proper object (as could see am able to access hard coded way, but could not access in loop)

Update: As per Vityata's hint, below code seem to be working fine. Thank you all for such immediate help. :)

For Each Item In JSON
    ActiveSheet.Cells(i + 2, baseCol).Value = Item.Keys
    For Each curr In Item
        ActiveSheet.Cells(i + 2, buyCol).Value = JSON(i)(curr)("buyPrice")
        ActiveSheet.Cells(i + 2, sellCol).Value = JSON(i)(curr)("sellPrice")
        i = i + 1
    Next curr
Next Item
like image 236
Parthiban Rajendran Avatar asked Feb 15 '18 14:02

Parthiban Rajendran


2 Answers

It you hard-code the "sellPrice", you can come up with something like this:

Dim something, someItem, cnt&
For Each something In JSON
    For Each someItem In something
        cnt = cnt + 1
        Debug.Print someItem
        Debug.Print JSON(cnt)(someItem)("sellPrice")
    Next someItem
Next something

And in the immediate window:

BTC
 623900 
XRP
 70,35 
NEO
 7699,5 
GAS
 2848,97 
ETH
 59500 
XLM
 28,38 

The keys and the items are collection, which can be looped through:

Dim something, someItem, cnt&, obj, iO
For Each something In JSON
    For Each someItem In something
        cnt = cnt + 1
        Debug.Print someItem
        Set obj = JSON(cnt)(someItem)
        For Each iO In obj.Keys
            Debug.Print iO
            Debug.Print obj.item(iO)
        Next iO
    Next someItem
Next something

In the immediate window:

BTC
sellPrice
 625000 
buyPrice
 624000 
lastTradePrice
 625000 
XRP
sellPrice
 70,2 
buyPrice
 70,1 
lastTradePrice
 70,2 
like image 170
Vityata Avatar answered Oct 18 '22 01:10

Vityata


Not a perfectly tidy, yet, version but here goes:

Version 2 (1 less loop) - I switched to reading the JSON from file due to API call time outs

Option Explicit

Public Sub test3()

    Dim fso As FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set fso = New FileSystemObject
    Set JsonTS = fso.OpenTextFile(ThisWorkbook.Path & Application.PathSeparator & "newFile.txt", ForReading)

    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim JSON As Object
    Dim Dict As Dictionary
    Dim key As Variant

    Set JSON = ParseJson(JsonText)

    For Each Dict In JSON                 'loop items of collection which returns dictionaries of dictionaries

        For Each key In Dict(Dict.Keys(0))
            Debug.Print Dict.Keys(0) & " - " & key & ":" & Dict(Dict.Keys(0))(key)
        Next key

    Next Dict

End Sub

Version 1:

Option Explicit

Public Sub test()

    Dim strResult As String
    Dim objHTTP As Object
    Dim URL As String
    Dim JSON As Object

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

    URL = "https://bitbns.com/order/getTickerAll"
    objHTTP.Open "GET", URL, False
    objHTTP.Send

    Set JSON = JsonConverter.ParseJson(objHTTP.ResponseText)

    Dim currItem As Dictionary
    Dim DictKey As Variant
    Dim targetValue As Variant

    For Each currItem In JSON                         'loop items of collection which returns dictionaries of dictionaries

        For Each DictKey In currItem.Keys 'currItem is a dictionary; dictKey is a key

            For Each targetValue In currItem(DictKey).Keys 'currItem(DictKey) returns a dictionary

                Debug.Print DictKey & "-" & targetValue & ": " & currItem(DictKey)(targetValue)

            Next targetValue

        Next DictKey

    Next currItem

End Sub
like image 28
QHarr Avatar answered Oct 18 '22 00:10

QHarr