在Excel VBA中解析JSON

如果你想建立在 ScriptControl 的顶部，你可以添加几个帮助方法来获取所需的信息。 JScriptTypeInfo 对象有点不幸：它包含所有相关信息（您可以在 Watch 窗口中看到），但似乎不可能得到在VBA上。但是，Javascript引擎可以帮助我们：

If you want to build on top of ScriptControl, you can add a few helper method to get at the required information. The JScriptTypeInfo object is a bit unfortunate: it contains all the relevant information (as you can see in the Watch window) but it seems impossible to get at it with VBA. However, the Javascript engine can help us:

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数组提供属性长度， 0 ，项目0 ， 1 ，项目1 等。使用VBA点符号（ jsonObject.property ），只有在您声明一个名为长度的变量，所有小写字母才可访问。否则情况不匹配，找不到。其他属性在VBA中无效。所以更好地使用 GetProperty 函数。


• 代码使用早期绑定。所以你必须添加Microsoft Script Control 1.0的引用。


• 在使用其他函数之前，您必须调用 InitScriptEngine 做一些基本的初始化。

• If the JScriptTypeInfo instance refers to a Javascript object, For Each ... Next won't work. However, it does work if it refers to a Javascript array (see GetKeys function).
• The access properties whose name is only known at run-time, use the functions GetProperty and GetObjectProperty.
• The Javascript array provides the properties length, 0, Item 0, 1, Item 1 etc. With the VBA dot notation (jsonObject.property), only the length property is accessible and only if you declare a variable called length with all lowercase letters. Otherwise the case doesn't match and it won't find it. The other properties are not valid in VBA. So better use the GetProperty function.
• The code uses early binding. So you have to add a reference to "Microsoft Script Control 1.0".
• You have to call InitScriptEngine once before using the other functions to do some basic initialization.