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

Question

基本上我想读取一些带有非常结构化数据(许多数组、项目和值)的 .JSONn 文件，我的目标是将项目和值放在 Excel 表中。当我到达数组数据类型时，我遇到了困难。

我可以使用 Library 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

这是一个有用的例程，可以帮助您根据 this answer 中的信息确定如何解析 JSON 数据。 .该例程是递归的，因此它会依次调用自身以继续解析 JSON 输入。

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

注意 level每个 JSON 级别的参数增加 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