如何使用VBA在JSON文件中获取多个数组中的所有项目？

Question

基本上，我想读取具有结构化数据（许多数组，项目和值）的某些.JSONn文件，而我的目标是将项目和值放入Excel工作表中。 当我到达数组数据类型时，我很难卡住。

我可以使用库VBA-JSON 2.3.1读取文件并包含一些项目和值

Dim jsonObject As Object, i As Integer, FSO

Set FSO = CreateObject("Scripting.FileSystemObject")
Set JsonTS = FSO.OpenTextFile("D:\JSON\file.json", ForReading)

JsonText = JsonTS.ReadAll

JsonTS.Close

Set ws = Worksheets("Sheet1")
Set jsonObject = JsonConverter.ParseJson(JsonText)

i = 2
n = 1

    For Each Item In jsonObject
        ws.Cells(i, n) = jsonObject(Item)
        i = i + 1: n = n + 1
    Next

    MsgBox ("Complete!")

Set jsonObject = Nothing

这是我构造的JSON文件：

{
  "id": "2ca5da11-b311-43db-9661-afa3b833aad4",
  "name": "_menuAposentacoes",
  "auto": true,
  "contexts": [],
  "responses": [
    {
      "resetContexts": false,
      "affectedContexts": [
        {
          "name": "aposentacoes_22-followup",
          "parameters": {},
          "lifespan": 2
        }
      ],
      "parameters": [
        {
          "id": "6e86b18e-77c1-4571-ad53-eba8db91d4b3",
          "required": false,
          "dataType": "@aposentacao",
          "name": "aposentacao",
          "value": "$aposentacao",
          "promptMessages": [],
          "noMatchPromptMessages": [],
          "noInputPromptMessages": [],
          "outputDialogContexts": [],
          "isList": true
        },
        {
          "id": "be28b756-32dd-40e7-99db-d7f91cc9ddb6",
          "required": false,
          "dataType": "@CGA",
          "name": "CGA",
          "value": "$CGA",
          "promptMessages": [],
          "noMatchPromptMessages": [],
          "noInputPromptMessages": [],
          "outputDialogContexts": [],
          "isList": false
        },
        {
          "id": "f52786f0-15cd-4fc4-983f-32b248ddcf3f",
          "required": false,
          "dataType": "@descontos",
          "name": "descontos",
          "value": "$descontos",
          "promptMessages": [],
          "noMatchPromptMessages": [],
          "noInputPromptMessages": [],
          "outputDialogContexts": [],
          "isList": false
        },
        {
          "id": "6e7f4c49-f35f-46fb-9db9-c24eb16f0b40",
          "required": false,
          "dataType": "@situacaoCGA",
          "name": "situacaoCGA",
          "value": "$situacaoCGA",
          "promptMessages": [],
          "noMatchPromptMessages": [],
          "noInputPromptMessages": [],
          "outputDialogContexts": [],
          "isList": false
        },
        {
          "id": "70328121-e748-4508-a287-7fc30a9cd9f6",
          "required": false,
          "dataType": "@penalizacao",
          "name": "penalizacao",
          "value": "$penalizacao",
          "promptMessages": [],
          "noMatchPromptMessages": [],
          "noInputPromptMessages": [],
          "outputDialogContexts": [],
          "isList": false
        }
      ],
      "messages": [
        {
          "type": 0,
          "lang": "pt",
          "speech": "Some text."
        },
        {
          "type": 4,
          "lang": "pt",
          "payload": {
            "message": "Some text: ",
            "ignoreTextResponse": false,
            "platform": "kommunicate",
            "metadata": {
              "contentType": "300",
              "templateId": "6",
              "payload": [
                {
                  "title": "Other text",
                  "message": "Other text"
                },
                {
                  "title": "Other text",
                  "message": "Other text"
                },
                {
                  "title": "Other text",
                  "message": "Other text"
                },
                {
                  "title": "Other text",
                  "message": "Other text"
                }
              ]
            }
          }
        },
        {
          "type": 4,
          "lang": "pt",
          "payload": {
            "message": "Other text",
            "ignoreTextResponse": false,
            "platform": "kommunicate",
            "metadata": {
              "contentType": "300",
              "templateId": "6",
              "payload": [
                {
                  "title": "Sim",
                  "message": "Sim"
                },
                {
                  "title": "Não",
                  "message": "Não"
                }
              ]
            }
          }
        }
      ],
      "defaultResponsePlatforms": {},
      "speech": []
    }
  ],
  "priority": 500000,
  "webhookUsed": false,
  "webhookForSlotFilling": false,
  "fallbackIntent": false,
  "events": []
}

Answer 1

这是一个有用的例程，可以根据此答案中的信息来帮助您确定如何解析JSON数据。 该例程是递归的，因此它将连续调用自身以继续解析JSON输入。

当前输出是使用Debug.Print到即时窗口的，但是您可以修改这些语句，以根据需要和格式将结果放入工作表单元格（在问题中并未真正指定）。

请注意，每个JSON级别将level参数增加2。 这可能是由于JSON源本身的格式。 例如，顶级responses字段同时具有[和{以指示内部结构。 您可以调整逻辑以处理此问题，但最适合您的用例。

Option Explicit

Sub ImportJSON()
    Dim fso As FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim jsonFilename As String
    Dim jsonFile As Object
    Dim jsonText As String
    jsonFilename = "D:\JSON\file.json"
    Set jsonFile = fso.OpenTextFile(Filename:=jsonFilename, IOMode:=ForReading)
    jsonText = jsonFile.ReadAll
    jsonFile.Close

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

    OutputJSON "(top)", json, 1
End Sub

Sub OutputJSON(ByVal itemName As String, _
               ByRef jsonItem As Variant, _
               ByVal level As Long)
    Dim item As Variant
    Select Case TypeName(jsonItem)
        Case "Dictionary"
            For Each item In jsonItem
                If IsObject(jsonItem(item)) Then
                    If jsonItem(item).Count = 0 Then
                        Debug.Print level & " " & itemName & "." & _
                                    item & " is empty " & _
                                    TypeName(jsonItem(item))
                    Else
                        OutputJSON itemName & "." & item, jsonItem(item), level + 1
                    End If
                Else
                    Debug.Print level & " " & itemName & "." & _
                                item & " = " & jsonItem(item)
                End If
            Next item

        Case "Collection"
            Dim i As Long
            i = 1
            For Each item In jsonItem
                If IsObject(item) Then
                    OutputJSON itemName & "[" & i & "]", item, level + 1
                Else
                    Debug.Print level & ": " & itemName & "[" & i & "]", item
                End If
                i = i + 1
            Next item
    End Select
End Sub