Parse JSON using VBA to Loop through all the components of JSON objects and extract label, key, value of each components

Question

I have a VBA code that can parse some particular JSON files and get the array("components") from different depths/layers. Once any components is found, it then extract it's label and check if it contains columns, data, or values.

• if columns is found then again check if it contains components
• if data is found then check if it contains values
• if values is found then extract its "label" and "value"

Following code is doing most of it, but some how not perfect. It come up with correct results 90% of the time.

I am in a search of a loop that can follow the same pattern but can go deeper as much as it can and extract the "label", "key" and "value" from every component it can find.

Possible path ways are (used JSON editor online to imagine the structure of different JSON):

1. components > components > columns > components > data > values
2. components > components > columns > components > values
3. components > components > data > values
4. components > components > values
5. components > columns > components > data > values
6. components > columns > components > values
7. components > data > values
8. components > values

In nutshell, for every components found, it will check, if columns exits, or data exist, or values exits.

if I follow the same structure of the following code then it would be a lot of repeated code so I am in a search of a efficient code that can do all above but in less number of lines. I think that loop will be the answer, but I am not sure how to utilize it in following code.

I have been using JsonConverter to parse JSON file and then using following code:

Private Sub Test()
    '==== Change this part according to your implementation..."
    Dim jsontxt As String
    jsontxt = OpenTxtFile("D:/TestJSON2.txt")
    '====

    Dim jSon As Scripting.Dictionary
    Set jSon = JsonConverter.ParseJson(jsontxt)
            
    'Check if first level of components exist and get the collection of components if true

    If jSon.Exists("components") Then
        Dim components As Collection
        Set components = jSon("components")
        
        Set Dict = New Scripting.Dictionary
        Set DictValue = New Scripting.Dictionary
        
        Dim comFirst As Variant
        Dim comSecond As Variant
        Dim comThird As Variant
        Dim columnsDict As Variant
        Dim valDict As Variant
                    
        For Each comFirst In components
            If Not Dict.Exists(comFirst("label")) Then Dict.Add comFirst("label"), comFirst("key")
            
Columns:
    If comFirst.Exists("columns") Then
        For Each columnsDict In comFirst("columns")
        
            If columnsDict.Exists("components") Then
                For Each comSecond In columnsDict("components")
                
                    If Not Dict.Exists(comSecond("label")) Then Dict.Add comSecond("label"), comSecond("key")
                    If comSecond.Exists("data") Then
                        If comSecond("data").Exists("values") Then
                            For Each valDict In comSecond("data")("values")
                                If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                            Next valDict
                        End If
                    End If
                    If comSecond.Exists("values") Then
                        For Each valDict In comSecond("values")
                            If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                        Next valDict
                    End If
                    
                Next
            End If
            
        Next
    End If

Data:
    If comFirst.Exists("data") Then
        If comFirst("data").Exists("values") Then
            For Each valDict In comFirst("data")("values")
                If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
            Next valDict
        End If
    End If

Values:
    If comFirst.Exists("values") Then
        For Each valDict In comFirst("values")
            If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
        Next valDict
    End If

            
            
            
            '++++ New JSON Format ++++
            '==== Check if second level of "components" key exist and extract label-key if true
            If comFirst.Exists("components") Then
            
                For Each comSecond In comFirst("components")
                    If Not Dict.Exists(comSecond("label")) Then Dict.Add comSecond("label"), comSecond("key")
                                    
                    '=== Check if "columns" key exist and extract the key-label if true
                    If comSecond.Exists("columns") Then
                        For Each columnsDict In comSecond("columns")
                        
                            '==== Check if third level of "components" key exist and extract key-label if true
                            If columnsDict.Exists("components") Then
                                For Each comThird In columnsDict("components")
                                    If Not Dict.Exists(comThird("label")) Then Dict.Add comThird("label"), comThird("key")
                                    
                                    If comThird.Exists("data") Then
                                        If comThird("data").Exists("values") Then
                                            For Each valDict In comThird("data")("values")
                                                If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                                            Next valDict
                                        End If
                                    End If

                                    '==== Check if "values" key exist and extract label-value if true
                                    If comThird.Exists("values") Then
                                        For Each valDict In comThird("values")
                                            If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                                        Next valDict
                                    End If
                                    '====
                                    
                                Next comThird
                            End If
                            '====
                            
                        Next columnsDict
                    End If
                    '====
                    
                    
    
                    If comSecond.Exists("data") Then
                        If comSecond("data").Exists("values") Then
                            For Each valDict In comSecond("data")("values")
                                If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                            Next valDict
                        End If
                    End If

                    '==== Check if "values" key exist and extract the label-value if true
                    If comSecond.Exists("values") Then
                        For Each valDict In comSecond("values")
                            If Not DictValue.Exists(valDict("label")) Then DictValue.Add valDict("label"), valDict("value")
                        Next valDict
                    End If
                    '====
                Next comSecond
            End If
            '++++
            
        Next comFirst
    End If

Example for FaneDuru:

Collection of components contain label and key as follows:

"label":"Ausstelldatum für alle Dokumente lautet", "key":"ausstelldatumFurAlleDokumenteLautet"

So I need to store label and its key in Dictionary as my previous VBA code already doing.

Dict.Add comFirst("label"), comFirst("key")

Same goes for collection/Object Values in example:

• "label":"Anschreiben",

  "value":"anschreiben"

• "label":"Arbeitsvertrag",

  "value":"arbeitsvertrag"

• "label":"Dienstwagenüberlassungsvertrag",

  "value":"dienstwagenuberlassungsvertrag"

• "label":"Prämie Empfehlung Kollegen",

  "value":"pramieEmpfehlungKollegen"

here I need to store all the label and its value in Dictionary as my previous VBA code already doing.

DictValue.Add valDict("label"), valDict("value")