Reputation: 33
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 =
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 ? Thank you
Upvotes: 3
Views: 1086
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