Home > Back-end >  Parse JSON objects and collection using VBA
Parse JSON objects and collection using VBA

Time:11-18

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
        }
    ]
}

New JSON file: enter image description here

CodePudding user response:

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.

Private Sub Test()
    '==== Change this part according to your implementation..."
    Dim jsontxt As String
    jsontxt = OpenTxtFile("D:/TestJSON.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
            Dict.Add comFirst("key"), comFirst("label")
            
            '==== Check if second level of "components" key exist and extract key-label if true
            If comFirst.Exists("components") Then
                For Each comSecond In comFirst("components")
                    Dict.Add comSecond("key"), comSecond("label")
                                    
                    '=== 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")
                                    Dict.Add comThird("key"), comThird("label")
                                    
                                    '==== Check if "values" key exist and extract label-value if true
                                    If comThird.Exists("values") Then
                                        For Each valDict In comThird("values")
                                            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")
                            Dict.Add valDict("label"), valDict("value")
                        Next valDict
                    End If
                    '====
                    
                Next comSecond
            End If
        Next comFirst
    End If
End Sub

CodePudding user response:

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

  • Related