Api are the same and change only the ID
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 ?
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.
all are dictionaries so you have to access items within those by key.
last_battle_time appears to be a key for the dictionary:
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