Recibo una respuesta json de una API y la analizo para actualizarla en Excel. A continuación se muestra el código. No puedo analizar más para obtener la información del precio.

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

Amablemente ayuda. Como vería en un comentario anterior, puedo obtener datos codificados

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

Pero cuando trato de poner eso en bucle, no puedo. A continuación se muestran los que probé pero no funcionaron.

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

Para analizar JSON, utilizo la biblioteca vbaJSON. Parece devolver el objeto adecuado (como pude ver, puedo acceder de forma codificada, pero no pude acceder en bucle)

Actualización : según la sugerencia de Vityata, el siguiente código parece funcionar bien. Gracias a todos por esta ayuda tan inmediata. :)

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
3
Parthiban Rajendran 15 feb. 2018 a las 17:21

2 respuestas

La mejor respuesta

Si codificas el "sellPrice", puedes encontrar algo como esto:

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

Y en la ventana inmediata:

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

Las claves y los elementos son de colección, que se pueden recorrer a través de:

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

En la ventana inmediata:

BTC
sellPrice
 625000 
buyPrice
 624000 
lastTradePrice
 625000 
XRP
sellPrice
 70,2 
buyPrice
 70,1 
lastTradePrice
 70,2 
3
Vityata 15 feb. 2018 a las 15:52

No es una versión perfectamente ordenada, pero aquí va:

Versión 2 (1 bucle menos): pasé a leer el JSON del archivo debido a que se agotó el tiempo de espera de las llamadas a la API

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

Versión 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
1
QHarr 16 feb. 2018 a las 09:32