问题描述
下面的例子...从解析的JSON字符串中循环一个对象返回错误对象不支持此属性或方法。有人建议如何使这项工作吗?非常感谢(我花了6个小时寻找答案,然后问这里)。
将JSON字符串解析为对象的功能(可以正常工作)
函数jsonDecode(jsonString As Variant)
设置sc = CreateObject(ScriptControl):sc.Language =JScript
设置jsonDecode = sc.Eval((+ jsonString +) )
结束函数
循环通过解析的对象返回错误对象不支持此属性或方法。
Sub TestJsonParsing()
Dim arr As Object'将json数组解析为
Dim jsonString As String
'这个工作很好
jsonString ={'key1':'value1','key2':'value2'}
设置arr = jsonDecode(jsonString)
MsgBox arr.key1'工作(只要我知道密钥名称)
'但这个循环不行 - 我做错了什么?
对于每个keyName在arr.keys的Excel错误在这里对象不支持此属性或方法
MsgBoxkeyName =& keyName
MsgBoxkeyValue =& arr(keyName)
下一个
End Sub
PS。我已经查看了这些图书馆:
- 无法得到这个例子。
- 没有包含vba脚本(这可能工作,但不知道如何加载到Excel中,最少的文档)。
另外,是否可以访问多维解析的JSON数组?只要得到一个单维数组循环工作就会很好(抱歉如果要求太多)。谢谢。
编辑:这是使用vba-json库的两个工作示例。上面的问题仍然是一个谜,虽然...
Sub TestJsonDecode()'这个工作,使用vba-json库
/ pre>
Dim lib作为新的JSONLib'实例化JSON类对象
Dim jsonParsedObj As Object'不需要
jsonString ={'key1':'val1','key2':'val2' $
设置jsonParsedObj = lib.parse(CStr(jsonString))
每个keyName在jsonParsedObj.keys
MsgBoxKeyname =& keyName& // Value =& jsonParsedObj(keyName)
下一个
设置jsonParsedObj = Nothing
设置lib = Nothing
End Sub
Sub TestJsonEncode()' ,使用vba-json库
Dim lib作为新的JSONLib'实例化JSON类对象
设置arr = CreateObject(Scripting.Dictionary)
arr(key1)= val1
arr(key2)=val2
MsgBox lib.toString(arr)
End Sub
解决方案
JScriptTypeInfo
对象有点不幸:它包含所有相关信息(您可以在 Watch 窗口中看到),但似乎不可能使用VBA。
如果
JScriptTypeInfo
实例指的是一个Javascript对象,For Each ... Next
将无法正常工作。但是,如果它指向一个Javascript数组(参见下面的GetKeys
函数),它的工作正常。
所以解决方法是再次使用Javascript引擎获取我们不能使用VBA的信息。首先,有一个函数来获取一个Javascript对象的键。
一旦你知道密钥,下一个问题是访问属性。如果密钥的名称只在运行时才知道,VBA将不会有帮助。所以有两种方法来访问对象的属性,一个用于值,另一个用于对象和数组。
选项显式
私有ScriptEngine As ScriptControl
公共子InitScriptEngine()
设置ScriptEngine =新ScriptControl
ScriptEngine.Language =JScript
ScriptEngine.AddCodefunction getProperty(jsonObj,propertyName){return jsonObj [propertyName];}
ScriptEngine.AddCode函数getKeys(jsonObj){var keys = new Array(); for(var i in jsonObj){ key.push(i);} return keys;}
End Sub
公共函数DecodeJsonString(ByVal JsonString As String)
设置DecodeJsonString = ScriptEngine.Eval(( + JsonString +))
结束函数
公共函数GetProperty(ByVal JsonObject As Object,ByVal propertyName As String)As Variant
GetProperty = ScriptEngine.Run(getProperty ,JsonObject,propertyName)
结束函数
公共功能在GetObjectProperty(ByVal JsonObject As Object,ByVal propertyName As String)As Object
Set GetObjectProperty = ScriptEngine.Run(getProperty,JsonObject,propertyName)
结束函数
公共函数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)
索引= 0
KeysObject中的每个键
KeysArray(Index)= Key
索引=索引+ 1
下一个
GetKeys = KeysArray
结束函数
公共Sub TestJsonAccess()
Dim JsonString As String
Dim JsonObject As Object
Dim Keys()As String
Dim值作为变量
Dim j As Variant
InitScriptE ngine
JsonString ={key1:val1,key2:{key3:val3}}
设置JsonObject = DecodeJsonString(CStr(JsonString))
Keys = GetKeys(JsonObject)
Value = GetProperty(JsonObject,key1)
设置值= GetObjectProperty(JsonObject, key2)
End Sub
注意:
- 代码使用早期绑定。所以你必须添加Microsoft Script Control 1.0的引用。
- 在使用其他函数之前,您必须调用
InitScriptEngine
做一些基本的初始化。
Per example below...Looping through an object from a parsed JSON string returns an error "Object doesn't support this property or method". Could anyone advise how to make this work? Much appreciated (I spent 6 hours looking for an answer before asking here).
Function to parse JSON string into object (this works OK).
Function jsonDecode(jsonString As Variant)
Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function
Looping through the parsed object returns error "Object doesn't support this property or method".
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. I looked into these libraries already:
-vba-json Wasn't able to get the example working.
-VBJSON There's no vba script included (this might work but don't know how to load it into Excel and there is minimum documentation).
Also, Is it possible to access Multidimensional parsed JSON arrays? Just getting a single-dimension array loop working would be great (sorry if asking too much). Thanks.
Edit: Here are two working examples using the vba-json library. The question above is still a mystery though...
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
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.
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 below).
So the workaround is to again use the Javascript engine to get at the information we cannot with VBA. First of all, there is a function to get the keys of a Javascript object.
Once you know the keys, the next problem is to access the properties. VBA won't help either if the name of the key is only known at run-time. So there are two methods to access a property of the object, one for values and the other one for objects and arrays.
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
Note:
- 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.
这篇关于Excel VBA:解析JSON对象循环的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!