时间戳

首页 > 解决方案 > 读取 JSON 并在 VBA 中循环

json - 读取 JSON 并在 VBA 中循环

问题描述

我从服务器获取带有特定操作状态的 JSON 字符串。在这种情况下，它返回 2 个操作的结果。对于 ID：551720 和 ID：551721

字符串如下所示：

[{"ElectronicId":551720,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"0050960000",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:21:23.743","Updated":"2019-07-23T21:21:24.587",
"Sent":"2019-07-23T21:21:24.587","Delivered":null},
{"ElectronicId":551721,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"00509605454",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:23:05.887","Updated":"2019-07-23T21:23:07.043",
"Sent":"2019-07-23T21:23:07.043","Delivered":null}]

有时它返回 1、有时 2 或 20 种状态（不同的“ElectronicId”）

我怎么能在 JSON 中循环。我有一个代码在我只有 1 个响应时有效，但当我有超过 1 个响应时它不起作用。这是 1 个响应的代码：

Dim cJS As New clsJasonParser

 cJS.InitScriptEngine

results = """""here goes the JSON string""""""

 Set JsonObject = cJS.DecodeJsonString(CStr(result))


        Debug.Print cJS.GetProperty(JsonObject, "ElectronicId")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentNr")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeId")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeName")
        Debug.Print cJS.GetProperty(JsonObject, "StatusId")

这是 clsJasonParser bClass 的代码：

Option Explicit

Private ScriptEngine As ScriptControl

Public Sub InitScriptEngine()

    Set ScriptEngine = New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "

End Sub

Public Function DecodeJsonString(ByVal JsonString As String)

    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")

End Function

Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant

    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)

End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object

    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)

End Function

标签： jsonexcelvbascriptcontrol

解决方案

我会使用jsonconverter.bas来解析 json。在名为 JsonConverter 的标准模块中安装该链接中的代码后，转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的引用。

然后我会标注一个数组来保存结果。我将根据返回的 json 集合中的项目数确定行数，并根据第一个项目字典的大小确定列数。循环json对象，内循环集合中每个字典的字典键，并填充数组。最后一口气写出数组。

下面，我正在从单元格 A1 读取 json 字符串，但您可以将其替换为您的 json 源。

Option Explicit
Public Sub test()
    Dim json As Object, r As Long, c As Long, headers()
    Dim results(), ws As Worksheet, item As Object, key As Variant

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set json = JsonConverter.ParseJson(ws.[A1].Value)  '<Reading json from cell. Returns collection
    headers = json.item(1).keys  'each item in collection is a dictionary. Use .keys to get headers for results e.g. ElectronicId
    ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
    For Each item In json 'loop json and populate results array
        r = r + 1: c = 1
        For Each key In item.keys
            results(r, c) = item(key)
            c = c + 1
        Next
    Next
    With ws
        .Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(3, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

推荐阅读