一般信息：

您可以使用下面的代码清空整个代码，该代码使用JSON converter：

备注：

我正在从工作表中阅读JSON字符串，并通过JSONConverter存储在对象中。初始对象是集合。我使用TypeName函数 * 循环该集合和每个嵌套级别，以确定每个级别存储了哪些对象。然后，我使用Select Case适当地处理这些对象。
更有效的方法是设计一个可重用的类来处理这个问题。我在SO上看到了一些其他的问题，这是在哪里做的。

• VarType实际上更健壮
  JSON示例

x1c 0d1x的数据

输出到立即窗口的示例代码：

通过将Debug.Print语句替换为工作表区域的赋值语句，可以选择写入单元格的方式。

的

VBA：

Option Explicit
Public Sub GetInfoFromSheet()
    Dim jsonStr As String
    jsonStr = [A1]                               '<== read in from sheet
    Dim json As Object
    Set json = JsonConverter.ParseJson(jsonStr)

    Dim i As Long, j As Long, key As Variant
    For i = 1 To json.Count
        For Each key In json(i).keys
            Select Case key
            Case "name", "type"
                Debug.Print key & " " & json(i)(key)
            Case Else
                Select Case TypeName(json(i)(key))
                Case "Dictionary"
                    Dim key2 As Variant
                    For Each key2 In json(i)(key)
                        Select Case TypeName(json(i)(key)(key2))
                        Case "Collection"
                            Dim k As Long
                            For k = 1 To json(i)(key)(key2).Count
                                Debug.Print key & " " & key2 & " " & json(i)(key)(key2)(k)
                            Next k
                        Case Else
                            Debug.Print key & " " & key2 & " " & json(i)(key)(key2)
                        End Select
                    Next key2
                Case "Collection"
                    For j = 1 To json(i)(key).Count '<== "actions"
                        Dim key3 As Variant
                        For Each key3 In json(i)(key)(j).keys
                            Select Case TypeName(json(i)(key)(j)(key3))
                            Case "String", "Boolean", "Double"
                                Debug.Print key & " " & key3 & " " & json(i)(key)(j)(key3)
                            Case Else
                                Dim key4 As Variant
                                For Each key4 In json(i)(key)(j)(key3).keys
                                    Debug.Print key & " " & key3 & " " & key4 & " " & json(i)(key)(j)(key3)(key4)
                                Next key4
                            End Select
                        Next key3
                    Next j
                Case Else
                    Debug.Print key & " " & json(i)(key)
                End Select
            End Select
        Next key
    Next i
End Sub

字符串

tl;dr;教程点：

因此，以上可能已经有点充分，因为它得到了一切没有大量的解释。下面，我们将更详细地介绍如何通过相关的VBA来定位JSON和 “talk”。
为此，您可以使用在线JSON解析器来更清楚地查看JSON的结构。我把你的JSON字符串放到Json Parser Online中，然后检查了String/parseJS eval中的结构;左手部分。还有其他工具可用。
首先要注意的是开头的"["。你可以在下面看到的第一个。

的
这表示Collection对象，当使用JsonConverter转换时，它是您的JSON字串。所有其他内容都嵌套在"["的左括号和最后的右括号之间。
接下来要注意的是，这是一个字典的集合，所以在其中形成“组”的一切都是字典。

的
看到"{"表示字典的开始了吗？
该词典的关键字为"name","type","actions"等。
一个初步的观察是，许多这些信息是空的，即。null的数据。我们可以使用IsNull测试忽略这些（我选择根据"name"字段执行此操作）：

If Not IsNull(json(i)("name"))

型
我们还可以看到，在"name"不是null的字典中，"actions"包含另一个字典集合。您可以看到，"["后跟"{"，如前所述。
x1c4d 1x型
我们可以看到，每个内部字典都有"name", "description"等的关键字。我们还可以看到它们的值具有不同的数据类型。
观察JSON结构中的"actions"，您可以看到以下内容（使用示例字典）：
1.字符串x1m 25n1x
1.字符串"description":"UTProject"
1.字符串“pattern":"UTProject"
1.布尔型"isCheck":true
1.双人间"sysid":1
1.字典"uftaction" 'keys of ==> "sysid_uftAction":2,"code":"code uft","maxTime":10,"nbCycle":20
因此，我们可以通过使用TypeName进行测试，使用Select Case来处理数据类型
对于基本的布尔型、字符串型和双精度型数据类型，我们可以简单地通过使用键（例如

json(i)("actions")(j)("isCheck")

型
这将是True或False.、i和j的布尔结果，True或False.、i和j是外部和内部集合的循环中的当前位置的索引。
对于字典"uftaction"，我们可以在其键上循环：

For Each key2 In json(i)("actions")(j)(key).keys 
    Debug.Print "actions " & key & " " & key2 & " " & json(i)("actions")(j)(key)(key2)
Next key2

型
当然，您也可以使用键的名称进行访问，而无需在键的末尾循环，例如：

json(i)("actions")(j)(key)("maxTime")

型
在整个过程中，你可以通过索引而不是循环访问特定的位置，这样i和j就可以直接用一个数值替换。和key, key2等可以由任何给定的 key 的实际文字字符串替换。
希望这能让你有更多的了解。

VBA：

Option Explicit
Public Sub GetInfoFromJSON()
    Dim jsonStr As String
    jsonStr = [A1]                               '<== read in from sheet
    Dim json As Object, i As Long
    Set json = JsonConverter.ParseJson(jsonStr) '<==This is a collection verified by Debug.Print TypeName(JSON)
    For i = 1 To json.Count
        If Not IsNull(json(i)("name")) Then
            'ignore the null names which have sys id only populated
            Debug.Print "name" & " " & json(i)("name")
            Debug.Print "type" & " " & json(i)("type")
            Dim j As Long
            For j = 1 To json(i)("actions").Count 'actions are a collection of dictionaries
                Dim key As Variant
                For Each key In json(i)("actions")(j).keys 'dictionary
                    'observing actions in the JSON structure you can see there are:
                    '                    String  "name":"UTProject"
                    'String "description":"UTProject",
                    'String "pattern":"UTProject",
                    'Boolean "isCheck":true,
                    'Double "sysid":1,
                    'Dictionary "uftaction" '==> "sysid_uftAction":2,"code":"code uft","maxTime":10,"nbCycle":20
                    'So we can use Select Case to handle the data type by testing with TypeName
                    Select Case TypeName(json(i)("actions")(j)(key))
                    Case "String", "Boolean", "Double" '<==good to go nothing extra needed
                        Debug.Print "actions " & key & " " & json(i)("actions")(j)(key)
                    Case Else                    ' we are dealing with uftaction which we know is a dictionary
                        Dim key2 As Variant
                        For Each key2 In json(i)("actions")(j)(key).keys '<==We know now we are looping the uftaction dictionary which has keys "sysid_uftAction","code","maxTime","nbCycle"
                            Debug.Print "actions " & key & " " & key2 & " " & json(i)("actions")(j)(key)(key2)
                        Next key2
                    End Select
                Next key
            Next j
        End If
    Next i
End Sub

型

我创建了这个简单的函数来格式化Json字符串，如果有人需要的话。代码非常简单。

Public Function indentJson(ByVal jsonIn As String) As String

Dim posizioneIndent As Integer
Dim contatore As Integer
Dim lungheza As Integer
Dim JsonOut As String
Dim i As Integer
Dim carattere As String

JsonOut = ""
lunghezza = Len(jsonIn)
contatore = 1
posizioneIndent = -1
carattere = ""

While contatore <> lunghezza + 1
        
    carattere = Mid(jsonIn, contatore, 1)
    
  If carattere = "{" Or carattere = "[" Then
    
     JsonOut = JsonOut & carattere
   JsonOut = JsonOut & Chr(13) & Chr(10)
     posizioneIndent = posizioneIndent + 1
     For i = 0 To posizioneIndent
     JsonOut = JsonOut & Space(5)
     Next i

  ElseIf carattere = "}" Or carattere = "]" Then
     JsonOut = JsonOut & Chr(13) & Chr(10)
     posizioneIndent = posizioneIndent - 1
     For i = 0 To posizioneIndent
      JsonOut = JsonOut + Space(5)
     Next i
     JsonOut = JsonOut + carattere
     'For i = 0 To posizioneIndent
     ' JsonOut = JsonOut + Space(5)
     'Next i

  ElseIf carattere = "," Then
JsonOut = JsonOut & carattere
JsonOut = JsonOut & Chr(13) & Chr(10)
For i = 0 To posizioneIndent
JsonOut = JsonOut + Space(5)
Next i

  Else
   JsonOut = JsonOut + carattere

End If

contatore = contatore + 1

Wend

indentJson = JsonOut

End Function

字符串
这是结果，在我的情况下，我把它放在一个文本框，如果有人有一个建议，以改善，请告诉我。

{
     "routingResponse":{
          "currentTimeUTC":"2022-10-16-09.16.48.012243+02:00",
          "executionMessage":{
               "code":0,
               "severity":"INFO",
               "codeDesc":"",
               "message":""
          },
          "arrivalTerminal":"031",
          "arrivalDepot":"031",
          "deliveryZone":"20",
          "consigneeZIPCode":"95024",
          "consigneeCity":"ACIREALE",
          "consigneeProvinceAbbreviation":"CT"
     }
}

型

看看下面的例子。将JSON.bas模块导入VBA工程进行JSON处理。

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

    ' Read JSON sample from file C:\Test\sample.json
    sJSONString = ReadTextFile("C:\Test\sample.json", 0)
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Convert raw JSON to 2d array and output to worksheet #1
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    ' Flatten JSON
    JSON.Flatten vJSON, vResult
    ' Convert flattened JSON to 2d array and output to worksheet #2
    JSON.ToArray vResult, aData, aHeader
    With Sheets(2)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Function ReadTextFile(sPath As String, lFormat As Long) As String

    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With

End Function

字符串
顺便说一句，类似的方法应用于in other answers。

我是这么做的：

Public Function indentJsonV2(ByVal jsonIn As String) As String
    Dim positionIndent As Double: positionIndent = -1
    Dim counter As Double: counter = 1
    Dim theLength As Double: theLength = Len(jsonIn)
    Dim JsonOut As String: JsonOut = vbNullString
    Dim i As Double: i = 0
    Dim theChar As String: theChar = vbNullString
    Dim twoChars As String: twoChars = vbNullString
    While counter <> theLength + 1
        theChar = Mid(jsonIn, counter, 1)
        twoChars = Mid(jsonIn, counter, 2)
        If theChar = "{" Or theChar = "[" Then
            JsonOut = JsonOut & theChar
            JsonOut = JsonOut & Chr(13) & Chr(10)
            positionIndent = positionIndent + 1
            For i = 0 To positionIndent
                JsonOut = JsonOut & Space(5)
            Next i
        ElseIf theChar = "}" Or theChar = "]" Then
            JsonOut = JsonOut & Chr(13) & Chr(10)
            positionIndent = positionIndent - 1
            For i = 0 To positionIndent
                JsonOut = JsonOut + Space(5)
            Next i
            JsonOut = JsonOut + theChar
            'For i = 0 To positionIndent
            ' JsonOut = JsonOut + Space(5)
            'Next i
        ElseIf twoChars = "]," Or twoChars = "}," Or twoChars = ",""" Then
            JsonOut = JsonOut & theChar
            JsonOut = JsonOut & Chr(13) & Chr(10)
            For i = 0 To positionIndent
                JsonOut = JsonOut + Space(5)
            Next i
        Else
            JsonOut = JsonOut + theChar
        End If
        counter = counter + 1
    Wend
    indentJsonV2 = JsonOut
End Function

字符串