Trouble creating a loop to fetch all the item and its values from json response

[shahin]

I've written a script to parse some json data from a webpage. In case of parsing an individual item and it's values, my script is doing fine. The problem is I can't create a loop to get them all . Any help on this will be a great relief for me. Thanks in advance.

This is exactly how the json data in that webpage look like:

[{"BTC":{"sellPrice":644999,"buyPrice":640601,"lastTradePrice":644900}},{"XRP":{"sellPrice":70.67,"buyPrice":70.5,"lastTradePrice":70.65}},{"NEO":{"sellPrice":8124,"buyPrice":7955,"lastTradePrice":8002}},{"GAS":{"sellPrice":2966.99,"buyPrice":2925,"lastTradePrice":2925}},{"ETH":{"sellPrice":59950,"buyPrice":59850,"lastTradePrice":60000}},{"XLM":{"sellPrice":28.38,"buyPrice":28.19,"lastTradePrice":28.39}}]

The script I've tried with:

Sub fetch_json_data()
    Dim HTTP As New XMLHTTP60, res As Variant

    With HTTP
        .Open "GET", "https://bitbns.com/order/getTickerAll", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        res = .responseText
    End With
    [A1] = Split(Split(res, "{""")(1), """:")(0)
    [B1] = Split(Split(Split(res, "BTC"":{")(1), "sellPrice"":")(1), ",")(0)
    [C1] = Split(Split(Split(res, "BTC"":{")(1), "buyPrice"":")(1), ",")(0)
    [D1] = Split(Split(Split(res, "BTC"":{")(1), "lastTradePrice"":")(1), "}}")(0)
End Sub

The result it produces:

BTC 644999 640601 644900

Btw, the data gets update in a regular interval so the output may vary. However, the basic structure is as I've shown above.

 

[Chihiro]

Stick first split result into variant array.

Then loop through it and use dictionary or other collection to hold values and return them to range.

 

[shahin]

Thanks sir Chihiro, for your response and suggestion. I really can't go forward.

 

[YasserKhalil]

Hello my friend
Here's the approach that Mr. Chihiro is talking about (I think so)

Sub Fetch_JSON_Data()
    Dim HTTP        As New XMLHTTP60
    Dim res        As Variant
    Dim x          As Variant
    Dim i          As Integer
    Dim r          As Integer

    With HTTP
        .Open "GET", "https://bitbns.com/order/getTickerAll", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        res = .responseText
    End With

    x = Split(res, "},")

    For i = LBound(x) To UBound(x)
        r = r + 1
        Cells(r, 1).Value = Split(Split(x(i), ",")(0), """")(1)
        Cells(r, 2).Value = Replace(Split(Split(x(i), ",")(0), """")(4), ":", "")
        Cells(r, 3).Value = Replace(Split(Split(x(i), ",")(1), """")(2), ":", "")
        Cells(r, 4).Value = Replace(Replace(Replace(Split(Split(x(i), ",")(2), """")(2), ":", ""), "}", ""), "]", "")
    Next i
End Sub

 

[shahin]

Yeah, it is doing the job. However, you are very close to what sir Chihiro suggested. Two things I need to fix now: 1. the loop 2. kicking out replace function. Will hopefully give here an update soon. Thanks Yasser, for your fruitful effort.

 

[Marc L]

As shown several times in your own previous threads
several ways upon brain level :

• Advanced to Expert : using a regular expression …

• Middle to Advanced : the ♪ Destiny's Child "Say My Name" ♫ way
directly in JScript via ScriptControl object and here
it is not difficult just by reading JSon data structure and
observing objects in Locals window, it works with few codelines !

• Beginner to Middle : using Split VBA function.
Just warming a couple of neurons,
see what returns Split("," & Mid(res, 2), ",{""") !
Then it needs only an unique additional Split on each item
without any Replace … (Logic found by a 14 years old child !)
As this way needs around 5 codelines to parse responseText …
​

 

[shahin]

Perhaps, the approach I've tried with is far away from the ideal solution. I'm pasting the code though.

Sub fetch_json_data()
    Dim HTTP As New XMLHTTP60, res As Variant
    Dim r As Long, v As Long

    With HTTP
        .Open "GET", "https://bitbns.com/order/getTickerAll", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        res = Split(.responseText, "{")
    End With

    On Error Resume Next  #could not get rid of it
    r = UBound(res)

    For v = 1 To r
        Cells(v, 1) = Split(Split(res(v), """sellPrice")(0), """")(1)
        Cells(v, 2) = Split(Split(Split(res(v), "sellPrice""")(1), ":")(1), ",")(0)
        Cells(v, 3) = Split(Split(Split(res(v), "buyPrice""")(1), ":")(1), ",")(0)
        Cells(v, 4) = Split(Split(Split(res(v), "lastTradePrice""")(1), ":")(1), "}}")(0)
    Next v
End Sub

If you take a look at the attached image, you can see that the data are getting parsed in every alternate row. Moreover, the data of the first column are not properly aligned with the rest.

 

[Marc L]

Bad first Split so bad loop ! Just check in Locals window …
Do not forget paper & pen before to write any codeline !

See Yasser's code and my previous post first Split as On Error uneeded,
if you need it with Split, it's far not a good code !
As yet shown in your previous threads …
​