使用 VBA 解析 JSON 字符串并遍历字典中的所有元素

Question

我一直在使用JsonConverter 解析JSONfile，然后使用以下代码将dictionary 中的所有“标签”和子“值”提取到我的用户表单combobox 中。

Set JSP = JsonConverter.ParseJson(JSONtxtString)

For Each A In JSP
    Debug.Print A
    If Not IsObject(JSP(A)) Then
        Debug.Print JSP(A)
        
    Else
        For Each B In JSP(A)
            If Not IsObject(JSP(B)) Then
                'Debug.Print B("label")
                    Me.AttributeComBo.AddItem B("label")
                    Me.ConditionBox.AddItem B("label")

                If B("type") = "selectboxes" Or B("type") = "select" Then
                    For Each C In B("values")
                       'Debug.Print C("label")
                       Me.CBSubValues.AddItem C("label")
                    Next C
                End If
            Else
            End If
        Next B
    End If
Next A

但是我无法从“喜欢的颜色”中获取值（“标签”）。来自以下 JSON。

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

我无法从标签（“最喜欢的颜色”）中获取值，即黑色、白色、蓝色、绿色 从任何 JSON 文件中提取所有值的更好解决方案是什么？ 如何遍历 JSON 中的每个对象并提取所有值？

Answer 1

在 VBA 中使用 JSON 可能会令人沮丧。我创建了this answer，用作我自己的参考。但更重要的是，花时间清楚地确定 JSON 的哪些部分被引用。

在您的情况下，顶层是Collection 的components。每个组件都有一个label。一个组件可能有一个values数组。

在“最喜欢的颜色”组件的情况下，values 在 data Dictionary 内。

下面是一些示例代码，我用它来保持清晰和直接：

Option Explicit
Sub test2(ByRef jsonText As String)

    Dim json As Variant
    Set json = JsonConverter.ParseJson(jsonText)

    Dim components As Collection
    Set components = json("components")
    
    Dim component As Variant
    For Each component In components
        Dim label As String
        label = component("label")
        Debug.Print "Label: " & label
        
        On Error Resume Next
        Dim values As Collection
        Set values = component("values")
        
        Dim data As Dictionary
        Set data = component("data")
        On Error GoTo 0
        
        Dim value As Variant
        If Not values Is Nothing Then
            For Each value In values
                Debug.Print "   Value: " & value("label")
            Next value
        ElseIf Not data Is Nothing Then
            Set values = data("values")
            For Each value In values
                Debug.Print "   Value: " & value("label")
            Next value
        Else
            Debug.Print "   No values"
        End If
        Set values = Nothing
        
    Next component
    
End Sub

请注意，values 不保证存在于每个component 中。这就是我们必须禁用/启用错误检查的原因。