Excel VBA:解析的JSON对象循环

Question

下面的示例...从解析的JSON字符串循环对象返回错误"对象不支持此属性或方法".任何人都可以建议如何使这项工作？非常感谢(我在这里问了6个小时寻找答案).

用于将JSON字符串解析为对象的函数(这可以正常工作).

Function jsonDecode(jsonString As Variant)
    Set sc = CreateObject("ScriptControl"): sc.Language = "JScript" 
    Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function

循环解析对象将返回错误"对象不支持此属性或方法".

Sub TestJsonParsing()
    Dim arr As Object 'Parse the json array into here
    Dim jsonString As String

    'This works fine
    jsonString = "{'key1':'value1','key2':'value2'}"
    Set arr = jsonDecode(jsonString)
    MsgBox arr.key1 'Works (as long as I know the key name)

    'But this loop doesn't work - what am I doing wrong?
    For Each keyName In arr.keys 'Excel errors out here "Object doesn't support this property or method"
        MsgBox "keyName=" & keyName
        MsgBox "keyValue=" & arr(keyName)
    Next
End Sub 

PS.我已经查看了这些库:

- vba-json无法使示例正常工作.
- VBJSON没有包含vba脚本(这可能有效,但不知道如何将其加载到Excel中,并且有最少的文档).

此外,是否可以访问多维解析的JSON数组？只是让单维数组循环工作会很棒(抱歉,如果要求太多).谢谢.

---

编辑:这是使用vba-json库的两个工作示例.上面的问题仍然是个谜......

Sub TestJsonDecode() 'This works, uses vba-json library
    Dim lib As New JSONLib 'Instantiate JSON class object
    Dim jsonParsedObj As Object 'Not needed

    jsonString = "{'key1':'val1','key2':'val2'}"
    Set jsonParsedObj = lib.parse(CStr(jsonString))

    For Each keyName In jsonParsedObj.keys
        MsgBox "Keyname=" & keyName & "//Value=" & jsonParsedObj(keyName)
    Next

    Set jsonParsedObj = Nothing
    Set lib = Nothing
End Sub

Sub TestJsonEncode() 'This works, uses vba-json library
    Dim lib As New JSONLib 'Instantiate JSON class object
    Set arr = CreateObject("Scripting.Dictionary")

    arr("key1") = "val1"
    arr("key2") = "val2"

    MsgBox lib.toString(arr)
End Sub

Answer 1

该JScriptTypeInfo对象有点不幸:它包含所有相关信息(正如您在Watch窗口中看到的那样),但似乎无法通过VBA获取它.

如果JScriptTypeInfo实例引用了Javascript对象,For Each ... Next则无法正常工作.但是,如果引用Javascript数组,它确实有效(请参阅GetKeys下面的函数).

因此,解决方法是再次使用Javascript引擎来获取我们无法使用VBA的信息.首先,有一个函数来获取Javascript对象的键.

一旦知道密钥,下一个问题就是访问属性.如果只在运行时知道密钥的名称,VBA也无济于事.因此,有两种方法可以访问对象的属性,一种用于值,另一种用于对象和数组.

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

注意:

• 该代码使用早期绑定.因此,您必须添加对"Microsoft Script Control 1.0"的引用.
• InitScriptEngine在使用其他函数进行一些基本初始化之前,必须先调用一次.

Answer 2

Codo的回答很好，并且构成了解决方案的中坚力量。

但是，您是否知道VBA的CallByName使您在查询JSON结构时走得很远。我刚刚在Google Places Details上用VBA编写了一个Excel解决方案。

实际上，只是按照本示例重写了它，而没有设法使用添加到ScriptEngine的函数。我实现了仅使用CallByName遍历数组。

所以一些示例代码来说明

'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Option Explicit

Sub TestJSONParsingWithVBACallByName()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim jsonString As String
    jsonString = "{'key1':'value1','key2':'value2'}"

    Dim objJSON As Object
    Set objJSON = oScriptEngine.Eval("(" + jsonString + ")")

    Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
    Debug.Assert VBA.CallByName(objJSON, "key2", VbGet) = "value2"

    Dim jsonStringArray As String
    jsonStringArray = "[ 1234, 4567]"

    Dim objJSONArray As Object
    Set objJSONArray = oScriptEngine.Eval("(" + jsonStringArray + ")")

    Debug.Assert VBA.CallByName(objJSONArray, "length", VbGet) = "2"

    Debug.Assert VBA.CallByName(objJSONArray, "0", VbGet) = "1234"
    Debug.Assert VBA.CallByName(objJSONArray, "1", VbGet) = "4567"


    Stop

End Sub

它也可以处理子对象（嵌套对象），也可以参见Google Places Details上的 Google Maps示例，使用VBA到Excel

编辑：不要使用Eval，尝试解析JSON更安全，请参阅此博客文章