Loop through the JSON object keys in excel vba

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

Slai · Accepted Answer · 2018-10-14T16:01:34.567

3

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

edited Oct 14 '18 at 16:01

answered Oct 14 '18 at 15:15

Slai

22,144
5
45
53

That's perfect solution. Just one note when dumping the results to the sheet, how can I get rid of the double quotes? – YasserKhalil Oct 14 '18 at 15:45
Nice. Will remember this! + – QHarr Oct 14 '18 at 15:47
Thanks a lot. I could solve it using these lines ` For Each item In jsonObject.Keys ws.Cells(i, 1) = item sTemp = JsonConverter.ConvertToJson(jsonObject(item)) ws.Cells(i, 2) = Mid(sTemp, 2, Len(sTemp) - 2) i = i + 1 Next item ` – YasserKhalil Oct 14 '18 at 15:51
Sorry for disturbing it seems that my code is not very accurate. How can I remove double quotes from the start and end of the result? – YasserKhalil Oct 14 '18 at 16:00
@YasserKhalil maybe if you can show me example of what you get and what you want. I didn't test, but you can try the update – Slai Oct 14 '18 at 16:03
The result "Close-Up" for example are surrounded by quotes. How can I remove those quotes? – YasserKhalil Oct 14 '18 at 16:05
@YasserKhalil as a side note, JSON can also be loaded in Excell with Power Query https://stackoverflow.com/questions/42060625/json-to-excel-using-power-query – Slai Oct 14 '18 at 16:19

QHarr · Answer 2 · 2018-10-14T14:27:30.067

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

That's great and awesome. Thank you very much Can the values in the nested collections be concatenated as one string for that key 'Ratings' so as to be like I have attached in main post — YasserKhalil, Oct 14 '18 at 13:19
Did you need everything? I have update to show how to generate that string. — QHarr, Oct 14 '18 at 14:28

Loop through the JSON object keys in excel vba

2 Answers2

Linked