VBA使用JsonConverter解析JSON遍历字典提取label及子值方案咨询

你原有代码只判断了组件对象下直接存在values属性的情况，但你提供的JSON里，Favorite color的选项列表是嵌套在data对象下的values字段里，所以原有逻辑遍历不到这部分值。

调整取值判断逻辑，兼容两种values存储结构即可：

Set JSP = JsonConverter.ParseJson(JSONtxtString)

' 先清空原有下拉选项避免重复
Me.AttributeComBo.Clear
Me.ConditionBox.Clear
Me.CBSubValues.Clear

For Each A In JSP
    If IsObject(JSP(A)) Then
        For Each B In JSP(A)
            ' 可自行加过滤逻辑，比如跳过无label的提交按钮
            If Not IsEmpty(B("label")) Then
                Me.AttributeComBo.AddItem B("label")
                Me.ConditionBox.AddItem B("label")
            End If
            
            If B("type") = "selectboxes" Or B("type") = "select" Then
                Dim valuesList As Object
                Set valuesList = Nothing
                ' 兼容两种values存储位置
                If B.Exists("values") Then
                    Set valuesList = B("values")
                ElseIf B.Exists("data") And B("data").Exists("values") Then
                    Set valuesList = B("data")("values")
                End If
                
                If Not valuesList Is Nothing Then
                    For Each C In valuesList
                        Me.CBSubValues.AddItem C("label")
                    Next C
                End If
            End If
        Next B
    End If
Next A

如果需要适配任意结构的JSON提取所有值，可使用递归遍历方法，不受嵌套层级限制：

Sub 递归遍历JSON(obj As Variant, Optional 层级 As Integer = 0)
    Dim key As Variant
    Dim item As Variant
    
    If TypeName(obj) = "Dictionary" Then
        For Each key In obj.Keys
            ' 可自定义提取逻辑，比如遇到label就存入下拉列表
            If key = "label" Then
                Debug.Print String(层级, " ") & "label: " & obj(key)
                ' 需要添加到下拉框就写：Me.对应下拉框名称.AddItem obj(key)
            End If
            
            If IsObject(obj(key)) Then
                递归遍历JSON obj(key), 层级 + 1
            Else
                Debug.Print String(层级, " ") & key & ": " & obj(key)
            End If
        Next
    ElseIf TypeName(obj) = "Collection" Then
        For Each item In obj
            If IsObject(item) Then
                递归遍历JSON item, 层级 + 1
            Else
                Debug.Print String(层级, " ") & item
            End If
        Next
    Else
        Debug.Print String(层级, " ") & obj
    End If
End Sub

调用方式：

Set JSP = JsonConverter.ParseJson(JSONtxtString)
' 直接传入解析后的JSON对象即可完成全量遍历
递归遍历JSON JSP

你只需在递归逻辑对应判断分支里添加自己需要的提取规则，就能适配所有结构的JSON取值需求。

内容的提问来源于stack exchange，提问作者VBAbyMBA