VBA-Json Parse Nested Json

Question

Thank you to @QHarr for working on this with me!

My goal is to grab the values for each of the nested categories from \"orders\"

my json:

{
         


        

Answer 1

I combined V1 and V2 above to produce the results, which was to capture values and save them into variables. This is my edited code: (I am still working on creating all of the cases and variables)

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\some.txt", ForReading) 'change as appropriate
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary

    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim initialCollection  As Collection

    Set initialCollection = Parsed("orders")

    Debug.Print initialCollection.Count ' 1 item which is a dictionary

    Dim initialDict As Dictionary

    Set initialDict = initialCollection(1)

    Dim Key As Variant
    Dim dataStructure As String

    For Each Key In initialDict.Keys

        dataStructure = TypeName(initialDict(Key))

        Select Case dataStructure

        Case "Dictionary"

        Dim Key1 As Variant

        For Each Key1 In initialDict(Key).Keys

           Select Case TypeName(initialDict(Key)(Key1))

           Case "String"

              'Debug.Print Key & " " & Key1 & " " & initialDict(Key)(Key1) 'amount/currency/symbol


                        'because the Key1 (amount) is the same for each Key ("Amount_product", "Amount_product_subtotal", and so on; (see Json above) I needed to concatenate them to extract unique values
                        Select Case Key & "_" & Key1


                        'first set of values "Amount_Product"
                        Case "Amount_product_amount"

                            dAmount_product_amount = initialDict(Key)(Key1)

                        Case "Amount_product_currency"

                            sAmount_product_currency = initialDict(Key)(Key1)

                        Case "Amount_product_symbol"

                            sAmount_product_symbol = initialDict(Key)(Key1)


                        'second set of values "Amount_Product_Subtotal"

                        Case "Amount_product_subtotal_amount"

                            dAmount_product_subtotal_amount = initialDict(Key)(Key1)

                        Case "Amount_product_subtotal_currency"

                            sAmount_product_subtotal_currency = initialDict(Key)(Key1)

                        Case "Amount_product_subtotal_symbol"

                            sAmount_product_subtotal_symbol = initialDict(Key)(Key1)

                        ' third set of values, and so on

                        End Select

                        'Debug.Print Key & ": " & Key1





           Case "Dictionary"

               Dim Key2 As Variant

               For Each Key2 In initialDict(Key)(Key1).Keys

                   'Debug.Print TypeName(initialDict(key)(Key1)(Key2)) 'strings and one dict

                   Select Case TypeName(initialDict(Key)(Key1)(Key2))

                       Case "String"

                           Debug.Print Key & " " & Key1 & " " & Key2 & " " & initialDict(Key)(Key1)(Key2)

                       Case "Dictionary"

                            Dim Key3 As Variant

                            For Each Key3 In initialDict(Key)(Key1)(Key2).Keys

                                'Debug.Print TypeName(initialDict(key)(Key1)(Key2)(Key3)) 'string only
                                Debug.Print initialDict(Key)(Key1)(Key2)(Key3)

                            Next Key3

                   End Select

               Next Key2

           Case Else

               MsgBox "Oops I missed this one"

           End Select

        Next Key1

        Case "String", "Boolean", "Double"

           Debug.Print Key & " : " & initialDict(Key)

        Case "Collection"

            'Debug.Print TypeName(initialDict(key)(1)) 'returns  1  Dict
            Dim Key4 As Variant

            For Each Key4 In initialDict(Key)(1).Keys   'Debug.Print TypeName(initialDict(key)(1)(Key4)) 'returns a dictionary

                Dim Key5 As Variant

                For Each Key5 In initialDict(Key)(1)(Key4).Keys ' Debug.Print TypeName(initialDict(key)(1)(Key4)(Key5)) returns 4 dictionaries

                   Dim Key6 As Variant

                   For Each Key6 In initialDict(Key)(1)(Key4)(Key5).Keys 'returns string

                       Debug.Print Key & "  " & Key4 & "  " & Key5 & "  " & Key6 & " " & initialDict(Key)(1)(Key4)(Key5)(Key6)

                   Next Key6

                Next Key5

            Next Key4

        Case Else

            MsgBox "Oops I missed this one!"

        End Select

    Next Key

End Sub

Answer 2

Ok solved (Oops....I think!). So, here are two versions dealing with the same JSON.

Version 1: A simple example showing you how to get the Amount_Product values you were after. Not the easiest to read syntax, but I have given the lengthy descriptions/syntax in version 2.

Version 2: Extracting all the values from the JSON.

Additional set-up requirements:

1) Reference required to MS Scripting Runtime in VBE > Tools > References

2) JSON Converter module by Tim Hall

Process:

I used TypeName(object) , at each stage, to understand which objects were being returned from the JSON. I have left some of these in (commented out as Debug.Print statements) so you have an idea what is going on at each stage.

Observations:

1) JsonConverter.ParseJson(JsonText) returns a dictionary to Parsed.

2) Parsed("orders") returns a collection which holds a single dictionary i.e. initialCollection(1)

3) That dictionary holds a variety of objects which is perhaps what is rather confusing.

If you run the following, to look at the objects in the dictionary:

Debug.Print  TypeName(initialDict(key))

You discover what a busy little dictionary it is. It hosts the following:

• Boolean * 3
• Collection * 1
• Dictionary * 9
• Double * 1
• String * 11

And so of course you keep delving into deeper levels of the nesting via these structures. The different handling, according to datatype, I have done via Select Case. I have tried to keep the terminology fairly straight forward.

How to use an Online JSON parser to examine structure:

So there are a number of online JSON parsers out there.

You pop your code in the left window (of the example I have given) and the right window shows the evaluation:

If you look at the initial red "[" ; this is the collection object you are getting with Parsed("orders").

Then you can see the first "{" before the "amount_product" which is your first dictionary within the collection.

And within that, associated with "amount_product" id, is the next dictionary where you see the next "{"

So you know you have to get the collection and then potentially iterate over two dictionaries to get the first set of values you were interested in.

I used a shortcut with Parsed("orders")(1)("amount_product").Keys ,in the first code example, to get to this inner dictionary to iterate over.

Results:

Code:

Version 1 (Simple):

Option Explicit

Public Sub test1()

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading)
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary 'or As Object if not including reference to scripting runtime reference in library
    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim key As Variant
    Dim sAmount As String 'Assume you will keep these as strings?
    Dim sCurrency As String
    Dim sSymbol As String

    For Each key In Parsed("orders")(1)("amount_product").Keys

        Dim currentString As String
        currentString = Parsed("orders")(1)("amount_product")(key)

        Select Case key

        Case "amount"

            sAmount = currentString

        Case "currency"

            sCurrency = currentString

        Case "symbol"

            sSymbol = currentString

        End Select

        Debug.Print key & ": " & currentString

    Next key

End Sub

Version 2: Grab everything. More descriptive.

Option Explicit

Sub test2()

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading) 'change as appropriate
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary

    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim initialCollection  As Collection

    Set initialCollection = Parsed("orders")

    ' Debug.Print initialCollection.Count ' 1 item which is a dictionary

    Dim initialDict As Dictionary

    Set initialDict = initialCollection(1)

    Dim key As Variant
    Dim dataStructure As String

    For Each key In initialDict.Keys

        dataStructure = TypeName(initialDict(key))

        Select Case dataStructure

        Case "Dictionary"

        Dim Key1 As Variant

        For Each Key1 In initialDict(key).Keys

           Select Case TypeName(initialDict(key)(Key1))

           Case "String"

              Debug.Print key & " " & Key1 & " " & initialDict(key)(Key1) 'amount/currency/symbol

           Case "Dictionary"

               Dim Key2 As Variant

               For Each Key2 In initialDict(key)(Key1).Keys

                   'Debug.Print TypeName(initialDict(key)(Key1)(Key2)) 'strings and one dict

                   Select Case TypeName(initialDict(key)(Key1)(Key2))

                       Case "String"

                           Debug.Print key & " " & Key1 & " " & Key2 & " " & initialDict(key)(Key1)(Key2)

                       Case "Dictionary"

                            Dim Key3 As Variant

                            For Each Key3 In initialDict(key)(Key1)(Key2).Keys

                                'Debug.Print TypeName(initialDict(key)(Key1)(Key2)(Key3)) 'string only
                                Debug.Print initialDict(key)(Key1)(Key2)(Key3)

                            Next Key3

                   End Select

               Next Key2

           Case Else

               MsgBox "Oops I missed this one"

           End Select

        Next Key1

        Case "String", "Boolean", "Double"

           Debug.Print key & " : " & initialDict(key)

        Case "Collection"

            'Debug.Print TypeName(initialDict(key)(1)) 'returns  1  Dict
            Dim Key4 As Variant

            For Each Key4 In initialDict(key)(1).Keys   'Debug.Print TypeName(initialDict(key)(1)(Key4)) 'returns a dictionary

                Dim Key5 As Variant

                For Each Key5 In initialDict(key)(1)(Key4).Keys ' Debug.Print TypeName(initialDict(key)(1)(Key4)(Key5)) returns 4 dictionaries

                   Dim Key6 As Variant

                   For Each Key6 In initialDict(key)(1)(Key4)(Key5).Keys 'returns string

                       Debug.Print key & "  " & Key4 & "  " & Key5 & "  " & Key6 & " " & initialDict(key)(1)(Key4)(Key5)(Key6)

                   Next Key6

                Next Key5

            Next Key4

        Case Else

            MsgBox "Oops I missed this one!"

        End Select

    Next key

End Sub

Final observation:

To be consistent, and to aid demonstrating what is going on, I have added all the .Keys, but it is unnecessary, when iterating in a For Each Loop over a Dictionary, to put .Keys, as shown in test below and in the embedded gif:

Option Explicit

Private Sub test()

    Dim testDict As Dictionary
    Set testDict = New Dictionary

    testDict.Add "A", 1
    testDict.Add "B", 2

    Dim key As Variant

    For Each key In testDict
        Debug.Print key & ":" & testDict(key)
    Next key

End Sub

So for example:

For Each key In initialDict.Keys => For Each key In initialDict