CODEWITHSUNDEEP
jsonexcelvbaweb-scraping
D.Sanna
D.Sanna

Reputation: 33

VBA parse json and loop different objects

I'm trying to parse the JSON data from API written in the sheet1 cells (B11:B15) into excel using VBA: API in cell B11 = enter image description here enter image description here

Api are the same and change only the ID

enter image description here

Here is the code that i'm using:

Option Explicit
Public r As Long, c As Long
Sub readValues()
    Dim sJSONString As String
    Dim ws As Worksheet
    Dim a As Integer
    Dim ID As String
    Dim I As Integer

    For a = 11 To 15
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Foglio1.Cells(a, 2), False
        .send
        sJSONString = .responseText
        'MsgBox sJSONString
    End With

    Dim JSON As Object, item As Object

    ID = Foglio1.Cells(a, 1)

    Set JSON = JsonConverter.ParseJson(sJSONString)("data")(ID)("statistics")("all")

    r = 1: c = 1

    EmptyDict JSON

    Next a
End Sub

Public Sub EmptyDict(ByVal dict As Object)

    Dim key As Variant, item As Object

    Select Case TypeName(dict)
    Case "Collection"

    For Each item In dict
        c = c
        r = r + 1
        EmptyDict item
    Next

    Case "Dictionary"
        For Each key In dict
            If TypeName(dict(key)) = "Collection" Then
                EmptyDict (dict(key))
            Else
                With ThisWorkbook.Worksheets("foglio1")
                    .Cells(r + 9, c + 5) = (key)
                    .Cells(r + 10, c + 5) = dict(key)
                End With
                c = c + 1
            End If

        Next

    End Select
End Sub

the code works fine but it cant loop the 5 ID APIs; the code writes all 5 items in the same row 11. in addition i would like to write the "all", "rating" objects and the "nickname"and "last battle time" in each row. Could someone help me ? Thank you

Upvotes: 3

Views: 1086

Answers (1)

QHarr
QHarr

Reputation: 84475

Each loop you are re-setting r = 1: c = 1 so you may be over-writing. Initialise r outside of the loop and then check where it needs to be incremented. Perhaps only within the function.

You need to ensure the c variable increments whilst the r remains constant to keep all in one row.

rating and all are dictionaries so you have to access items within those by key. last_battle_time appears to be a key for the dictionary: 507350581 (id?)

The below reads your json in from a cell and simply shows you how values are accessed. I am not using your function. Instead I would increment r during the loop.

Option Explicit
Sub test()
    Dim json As Object
    Set json = JsonConverter.ParseJson([A1])("data")("507350581")

    Dim battle As String, nickname As String                      '<just for sake of ease using this datatype
    battle = json("last_battle_time")
    nickname = json("nickname")
    Dim rating As Object, all As Object
    Set rating = json("statistics")("rating")
    Set all = json("statistics")("all")
    Dim r As Long, c As Long
    r = 2: c = 1

    With ActiveSheet
        .Cells(r, 1).Resize(1, rating.Count) = rating.Items
        .Cells(r, 1 + rating.Count).Resize(1, all.Count) = all.Items
        .Cells(r, 1 + rating.Count + all.Count) = nickname
        .Cells(r, 2 + rating.Count + all.Count) = battle
    End With

    'rating.keys  '<= array of the keys
    'rating.items '<== array of the items
    'rating and all can be passed to your function.
    Stop
End Sub

Upvotes: 2

Related Questions