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

Question

Basically I want to read some .JSONn files with very structured data (many arrays, items and values) and my goal is to put the items and values in an excel sheet. I have trouble getting stuck when I reach arrays data-type.

I can read the files and include some items and values using the 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

Here's my sructured JSON file:

{
  "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

Here's a useful routine that can help you determine how to parse the JSON data, based on information in this answer . The routine is recursive, so it will successively call itself to continue parsing the JSON input.

The current output is to the immediate window using Debug.Print , but you can modify these statements to put the results into worksheet cells according to your needs and format (which was not really specified in your question).

Notice that the level parameter is incremented by two with each JSON level. This is likely due to the format of the JSON source itself. For example, the top-level responses field has both a [ and a { to indicate internal structure. You can adjust the logic to deal with this however best suits your use case.

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