在Excel VBA中解析JSON

Question

我有与Excel VBA中相同的问题：解析的JSON对象循环，但是找不到任何解决方案。我的JSON具有嵌套对象，因此建议的解决方案（如VBJSON和vba-json）不适用于我。我还修复了其中之一，使其正常工作，但是由于doProcess函数的许多递归，结果是调用堆栈溢出。

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

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

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

Answer 1

如果要在的基础上构建ScriptControl，则可以添加一些帮助程序方法以获取所需的信息。该JScriptTypeInfo对象有点不幸：它包含所有相关信息（如您在“
监视” 窗口中看到的那样），但似乎无法使用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属性访问，则只有声明一个变量叫length所有的小写字母。否则，案例将不匹配，并且找不到。其他属性在VBA中无效。因此最好使用该GetProperty功能。
• 该代码使用早期绑定。因此，您必须添加对“ Microsoft Script Control 1.0”的引用。
• InitScriptEngine在使用其他功能进行一些基本初始化之前，您必须调用一次。