json - 在 Excel VBA 中解析 JSON

Question

我遇到了与 Excel VBA: Parsed JSON Object Loop 相同的问题但找不到任何解决方案。我的 JSON 具有嵌套对象，因此建议的解决方案(如 VBJSON 和 vba-json)对我不起作用。我还修复了其中一个以使其正常工作，但结果是由于 doProcess 函数的多次递归而导致调用堆栈溢出。

最好的解决方案似乎是原始帖子中看到的 jsonDecode 函数。它非常快速且高效；我的对象结构都存在于 JScriptTypeInfo 类型的通用 VBA 对象中。

此时的问题是我无法确定对象的结构，因此，我事先不知道每个通用对象中的键。我需要遍历通用 VBA 对象来获取键/属性。

如果我解析 javascript 函数可以触发 VBA 函数或子函数，那就太好了。

Answer 1

如果你想在 ScriptControl 之上构建，你可以添加一些帮助方法来获取所需的信息。 JScriptTypeInfo 对象有点不幸:它包含所有相关信息(如您在 Watch 窗口中所见)，但使用 VBA 似乎无法获得它。但是，Javascript 引擎可以帮助我们:

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

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function


Public Sub TestJsonAccess()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Value As Variant
    Dim j As Variant

    InitScriptEngine

    JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
    Set JsonObject = DecodeJsonString(CStr(JsonString))
    Keys = GetKeys(JsonObject)

    Value = GetProperty(JsonObject, "key1")
    Set Value = GetObjectProperty(JsonObject, "key2")
End Sub

几点说明:

• 如果 JScriptTypeInfo 实例引用 Javascript 对象，则 For Each ... Next 将不起作用。但是，如果它引用一个 Javascript 数组，它确实可以工作(参见 GetKeys 函数)。
• 名称仅在运行时知道的访问属性，使用函数 GetProperty 和 GetObjectProperty。
• Javascript 数组提供属性 length、0、Item 0、1、Item 1 等。使用 VBA 点表示法 (jsonObject.property)，只有长度属性是可访问的，并且只有当您声明一个名为 length 的变量时，所有小写字母。否则，案例不匹配，它不会找到它。其他属性在 VBA 中无效。所以最好使用 GetProperty 函数。
• 代码使用早期绑定(bind)。所以你必须添加对“Microsoft Script Control 1.0”的引用。
• 在使用其他函数进行一些基本初始化之前，您必须调用一次 InitScriptEngine。