下面的每个示例…从解析的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
该JScriptTypeInfo对象有点不幸:它包含所有相关信息(如您在“ 监视” 窗口中看到的那样),但似乎无法使用VBA来实现。
JScriptTypeInfo
如果JScriptTypeInfo实例引用Javascript对象,For Each ... Next将无法正常工作。但是,如果它引用Javascript数组,则它确实可以工作(请参见GetKeys下面的函数)。
For Each ... Next
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
注意:
InitScriptEngine