使用VBA+JsonConverter解析嵌套JSON提取components标签键值问题

现有代码存在的问题 #

1. 核心问题是逻辑仅覆盖了两层嵌套结构（根components + 第一层元素下的子components），没有处理子components内部再嵌套components的场景，因此遇到三级及以上深层嵌套时无法正确提取数据。
2. 细节问题：
   • 变量声明不规范：Dim Label, Key As String 只有Key被声明为String类型，Label实际为Variant类型
   • 未处理字典键重复：直接将label作为字典的键存储，若不同层级出现相同label会触发字典键重复报错
   • 提取逻辑有歧义：你当前代码中直接把子components的value字段作为值存储，和你需求里要提取子components的label和key的要求不一致

修复方案（递归实现任意层级解析） #

采用递归函数遍历所有层级的components，无需手动写多层循环即可覆盖所有嵌套层级，代码示例如下：

' 需要先引用：工具-引用-勾选「Microsoft Scripting Runtime」
Dim resultDict As Scripting.Dictionary

Sub MainParseJson()
    Dim jSonText As String
    ' 这里填入你的JSON文本内容
    jSonText = "你的JSON字符串"
    
    Dim jSon As Variant
    Set jSon = JsonConverter.ParseJson(jSonText)
    Set resultDict = New Scripting.Dictionary
    
    ' 开始递归解析根components
    ParseComponents jSon("components")
    
    ' 后续可以自行处理resultDict里的结果
    ' 示例：遍历输出所有键值
    Dim k As Variant
    For Each k In resultDict.Keys
        Debug.Print k & ": " & resultDict(k)
    Next
End Sub

' 递归解析components数组的公用函数
Sub ParseComponents(components As Collection)
    Dim comp As Variant
    Dim valuesCol As Collection
    Dim dataDict As Scripting.Dictionary
    Dim val As Variant
    
    For Each comp In components
        ' 1. 提取当前component的label和key，先判断键是否存在避免重复报错
        If Not resultDict.Exists(comp("label")) Then
            resultDict.Add comp("label"), comp("key")
        End If
        
        ' 2. 提取当前component下的values（含直接挂载和data下挂载的两种情况）
        On Error Resume Next
        Set valuesCol = comp("values")
        Set dataDict = comp("data")
        On Error GoTo 0
        
        If Not valuesCol Is Nothing Then
            For Each val In valuesCol
                If Not resultDict.Exists(val("label")) Then
                    resultDict.Add val("label"), val("value")
                End If
            Next
        ElseIf Not dataDict Is Nothing Then
            On Error Resume Next
            Set valuesCol = dataDict("values")
            On Error GoTo 0
            If Not valuesCol Is Nothing Then
                For Each val In valuesCol
                    If Not resultDict.Exists(val("label")) Then
                        resultDict.Add val("label"), val("value")
                    End If
                Next
            End If
        End If
        
        ' 3. 递归解析当前component下的子components数组
        On Error Resume Next
        Set valuesCol = comp("components")
        On Error GoTo 0
        If Not valuesCol Is Nothing Then
            ' 递归调用自身处理子层级components
            ParseComponents valuesCol
        End If
        
        ' 清空对象变量避免干扰下一次循环
        Set valuesCol = Nothing
        Set dataDict = Nothing
    Next
End Sub

注意事项 #

• 如果允许label重复，建议不要直接用label作为字典的唯一键，可以拼接对应层级的key或者序号作为前缀，避免数据丢失
• JsonConverter解析数组返回的是Collection类型，解析对象返回的是Dictionary类型，判断属性是否存在时也可以用comp.Exists("components")替代On Error Resume Next的写法，逻辑更严谨

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