Loop through the JSON object keys in excel vba - json

Question

I am trying to learn about JSON in excel vba so bear me ..
This is JSON sample ..
{"Title":"Close-Up","Year":"1990","Rated":"NOT RATED","Released":"30 Oct 1991","Runtime":"98 min","Genre":"Documentary, Biography, Crime","Director":"Abbas Kiarostami","Writer":"Abbas Kiarostami","Actors":"Hossain Sabzian, Mohsen Makhmalbaf, Abolfazl Ahankhah, Mehrdad Ahankhah","Plot":"The true story of Hossain Sabzian that impersonated the director Mohsen Makhmalbaf to convince a family they would star in his so-called new film.","Language":"Persian, Azerbaijani","Country":"Iran","Awards":"2 wins.","Poster":"https://m.media-amazon.com/images/M/MV5BMzE4Mjc0MjI1N15BMl5BanBnXkFtZTcwNjI3MzEzMw##._V1_SX300.jpg","Ratings":[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}],"Metascore":"N/A","imdbRating":"8.3","imdbVotes":"11,546","imdbID":"tt0100234","Type":"movie","DVD":"19 Feb 2002","BoxOffice":"N/A","Production":"Zeitgeist Films","Website":"http://www.zeitgeistfilm.com/current/closeup/closeup.html","Response":"True"}
This is in range("A1")
and I used this code to loop through each key and debug the key and its related value
Sub Test()
Dim ws As Worksheet
Dim jsonObject As Object
Dim item As Variant
Dim jsonText As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
jsonText = ws.Cells(1, 1).Value
Set jsonObject = JsonConverter.ParseJson(jsonText)
For Each item In jsonObject.Keys
Debug.Print item & vbTab & jsonObject(item)
Next item
End Sub
The code works well in regular combinations of key and value but encountered an error at the key 'Ratings' as it is not as the others
How can I print the value of this key without nested loops. I mean to print this output
[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}]
Thanks advanced for help

Answer 1

Sounds like you might want to stringify the values :
For Each item In jsonObject.Keys
Debug.Print item, Replace(JsonConverter.ConvertToJson(jsonObject(item)), """", "")
Next item

Answer 2

I would probably use a recursive sub to empty all the dictionaries including those inside the collection. It does have a level of nesting but it is minimal.
Public Sub GetInfoFromSheet()
Dim jsonStr As String, json As Object
jsonStr = [A1]
Set json = JsonConverter.ParseJson(jsonStr)
emptyDict json
End Sub
Public Sub emptyDict(ByVal json As Object)
Dim key As Variant, item As Object
For Each key In json
Select Case TypeName(json(key))
Case "String"
Debug.Print key & vbTab & json(key)
Case "Collection"
For Each item In json(key)
emptyDict item
Next
End Select
Next
End Sub
Examining your JSON structure:
You have an initial dictionary, denoted by {}, then within this a series of key and values pairs and a collection, denoted by []. That collection is made up also of dictionaries. So, I use a test with TypeName to determine if the top level dictionary value is String or Collection. If it is a Collection I recursively call the emptyDict sub to write out the results of the inner dictionaries.
To generate the string shown you only need what is in the collection:
Option Explicit
'[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}]
Public Sub GetInfoFromSheet()
Dim jsonStr As String, json As Object, item As Object, output As String, key As Variant
jsonStr = [A1]
Set json = JsonConverter.ParseJson(jsonStr)("Ratings")
For Each item In json
For Each key In item.keys
If key = "Value" Then
output = output & "," & Chr$(34) & key & Chr$(34) & ":" & Chr$(34) & item(key) & Chr$(34) & "}"
Else
output = output & ",{" & Chr$(34) & key & Chr$(34) & ":" & Chr$(34) & item(key) & Chr$(34)
End If
Next key
Next
output = "[" & Replace$(output, ",", vbNullString, , 1) & "]"
Debug.Print output
End Sub