Parse JSON objects and collection using VBA

Question

I have a JSON file which contains: array("components") of Objects

some of objects may have sub array("components") some don't. I need to extract the labels, keys of that array also the array("values") with all the labels, values.

HOWEVER following VBA code only work with first level of "components", do not dig into second or third levels. let me know if I am doing it right?

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

Dim jSon As Variant    
Set jSon = JsonConverter.ParseJson(jSonText)

Dim components As Collection
Set components = jSon("components")

Set Dict = New Scripting.Dictionary

Dim component As Variant
For Each component In components
    
    Dim Label, Key As String 'not used
    
        Dict.Add component("label"), component("key")
       
    On Error Resume Next
        Dim Values As Collection
        Set Values = component("components")
        
        Dim Data As Scripting.Dictionary
        Set Data = component("data")
    On Error GoTo 0
    
    Dim value As Variant
    If Not Values Is Nothing Then
        For Each value In Values
            
        Dict.Add value("label"), value("value")
            
        Next value
    ElseIf Not Data Is Nothing Then
        Set Values = Data("values")
        For Each value In Values
            
            Dict.Add value("label"), value("value")
           
        Next value
    Else
        'Debug.Print "   No values"
    End If
    Set Values = Nothing
    Set Data = Nothing

Next component

OLD JSON FILE - above code is working fine on this

{
    "display": "form",
    "settings": {
        "pdf": {
            "id": "1ec0f8ee-6685-5d98-a847-26f67b67d6f0",
            "src": "https://files8-a847-26f67b67d6f08-a847-26f67b67d6f0"
        }
    },
    "components": [
        {
            "label": "Family Name",
            "tableView": true,
            "key": "familyName",
            "type": "textfield",
            "input": true
        },
        {
            "label": "Amount of Money",
            "mask": false,
            "tableView": false,
            "delimiter": false,
            "requireDecimal": false,
            "inputFormat": "plain",
            "truncateMultipleSpaces": false,
            "key": "amountOfMoney",
            "type": "number",
            "input": true
        },
        {
            "label": "I hereby confirm",
            "tableView": false,
            "key": "iHerebyConfirm",
            "type": "checkbox",
            "input": true,
            "defaultValue": false
        },
        {
            "label": "Which Cities do you like",
            "optionsLabelPosition": "right",
            "tableView": false,
            "values": [
                {
                    "label": "New York",
                    "value": "newNew YorkYork",
                    "shortcut": ""
                },
                {
                    "label": "Munich",
                    "value": "Munich",
                    "shortcut": ""
                },
                {
                    "label": "Paris",
                    "value": "Paris",
                    "shortcut": ""
                },
                {
                    "label": "Hongkong",
                    "value": "Hongkong",
                    "shortcut": ""
                },
                {
                    "label": "Mumbai",
                    "value": "Mumbai",
                    "shortcut": ""
                }
            ],
            "key": "whichCitiesDoYouLike",
            "type": "selectboxes",
            "input": true,
            "inputType": "checkbox"
        },
        {
            "label": "Favorite color",
            "widget": "choicesjs",
            "tableView": true,
            "data": {
                "values": [
                    {
                        "label": "black",
                        "value": "black"
                    },
                    {
                        "label": "white",
                        "value": "white"
                    },
                    {
                        "label": "blue",
                        "value": "blue"
                    },
                    {
                        "label": "green",
                        "value": "green"
                    }
                ]
            },
            "key": "favoriteColor",
            "type": "select",
            "input": true
        },
        {
            "type": "button",
            "label": "Submit",
            "key": "submit",
            "disableOnInvalid": true,
            "input": true,
            "tableView": false
        }
    ]
}

To understand it I used http://jsoneditoronline.org/ try to convey in following picture

Can you provide the new JSON format in the question (like what you did for the old JSON format) instead of providing the link? — Raymond Wu
– Raymond Wu, Commented Nov 18, 2021 at 8:50
Dear! new JSON file is way bigger then 3000 words therefore I could not add it to the question. please download it from the link. — VBAbyMBA
– VBAbyMBA, Commented Nov 18, 2021 at 8:57
Well the issue is that 1) external file can expire in future = broken link and thus is not helpful for future user and 2) Not everyone can access external site (e.g. me, no access to FTP sites). Please provide a sample version of the JSON data (No need to show every single item in the collection if the format is going to be same) — Raymond Wu
– Raymond Wu, Commented Nov 18, 2021 at 9:16
@RaymondWu let me share a glimpse of it as much as it can bear. thanks for info — VBAbyMBA
– VBAbyMBA, Commented Nov 18, 2021 at 9:18
I suppose you can remove the old JSON format since it's not relevant in your question. — Raymond Wu
– Raymond Wu, Commented Nov 18, 2021 at 9:19

Raymond Wu · Accepted Answer · 2021-11-19 07:00:04Z

Take note that I have swapped the dictionary entry using key as the dictionary key and label as the value as label is not unique (as far as the sample JSON shows) and will cause an error (or overwrite previous entry, depending on implementation).

Your usage of On Error Resume Next should be avoided (this applies to any scenario, unless you are using it on purpose which is rarely needed) as you are basically hiding all possible errors which can cause your code to produce unintended result. You can use Exists method in If..Else..End If statement to check if the dictionary key exist first and only perform the task if it do exist.

EDIT - Code updated to handle both old and new JSON format

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")
    
        Dim Dict As Scripting.Dictionary
        Set Dict = 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
            'extract key-label from first level component
            If Not Dict.Exists(comFirst("label")) Then Dict.Add comFirst("label"), comFirst("key")
            
            '++++ 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")
                                    
                                    '==== Check if "values" key exist and extract label-value if true
                                    If comThird.Exists("values") Then
                                        For Each valDict In comThird("values")
                                            If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
                                        Next valDict
                                    End If
                                    '====
                                    
                                Next comThird
                            End If
                            '====
                            
                        Next columnsDict
                    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 Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
                        Next valDict
                    End If
                    '====
                Next comSecond
            End If
            '++++
            
            '++++ Old JSON format ++++
            '==== Check if "data" key exist and extract the label-value if true
            If comFirst.Exists("data") Then
                If comFirst("data").Exists("values") Then
                    For Each valDict In comFirst("data")("values")
                        If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
                    Next valDict
                End If
            End If
            '====
            
            '==== Check if "values" key exist and extract the label-value if true
            If comFirst.Exists("values") Then
                For Each valDict In comFirst("values")
                    If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
                Next valDict
            End If
            '====
            '++++
        Next comFirst
    End If
End Sub

it working perfectly well on new JSON, however did you consider extracting values from ("data") too? If there are duplicate I can handle it by : On Error Resume Next Dict.Add comFirst("label"), comFirst("key") On Error GoTo 0
@ibneAshiq I don't see data key in the new json, is the code supposed to handle both old and new json??? If there are duplicate, do you want to keep the old value or overwrite it with the new value?
yes sir! It should handle both situations if possible. for duplicate, keep the old, just for now
@IbneAshiq I suppose that's not difficult (just need another If block statement to handle the old json format) but I can only give you the answer tomorrow so either you try it out or wait for it.
@IbneAshiq Please try the updated code which should handle the old JSON format as well.

Terminader · Accepted Answer · 2021-11-18 08:31:30Z

-2

Try this:

https://github.com/VBA-tools/VBA-JSON

You need to import the file "JsonConverter.bas" in your project and then follow the examples in the README.md file

answered Nov 18, 2021 at 8:31

Terminader

705 bronze badges

1 Comment

VBAbyMBA Over a year ago

already did it. please see complete question

Collectives™ on Stack Overflow

Parse JSON objects and collection using VBA

2 Answers 2

5 Comments

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

5 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related