通过 VBA 解析 Json 数组

Question

我从 api 得到一个 json 响应并解析它以在 excel 中更新。下面是代码。我无法进一步解析以获取价格信息。

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

请帮忙。正如您在上面的评论中看到的那样，我能够获取硬编码的数据

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

但是当我尝试让它循环时，我无法做到。以下是我尝试过但没有成功的方法。

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")

为了解析 JSON，我使用 vbaJSON 库。它似乎返回了正确的对象（可以看到能够以硬编码方式访问，但无法循环访问）

更新：根据 Vityata 的提示，以下代码似乎运行良好。感谢大家的即时帮助。 :)

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

Answer 1

如果你硬编码“sellPrice”，你可以想出这样的东西：

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

在即时窗口中：

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

keys和items都是collection，可以循环遍历：

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

在即时窗口中：

BTC
sellPrice
 625000 
buyPrice
 624000 
lastTradePrice
 625000 
XRP
sellPrice
 70,2 
buyPrice
 70,1 
lastTradePrice
 70,2 

Answer 2

还不是一个完全整洁的版本，但这里有：

版本 2（少 1 个循环） - 由于 API 调用超时，我切换到从文件中读取 JSON

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

版本 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