我有与Excel VBA中相同的问题:解析的JSON对象循环,但是找不到任何解决方案。我的JSON具有嵌套对象,因此建议的解决方案(如VBJSON和vba-json)不适用于我。我还修复了其中之一,使其正常工作,但是由于doProcess函数的许多递归,结果是调用堆栈溢出。
最好的解决方案似乎是原始帖子中看到的jsonDecode函数。它非常快速且非常有效。我的对象结构全部位于类型JScriptTypeInfo的通用VBA对象中。
此时的问题是我无法确定对象的结构,因此,我事先不知道将驻留在每个通用对象中的键。我需要遍历通用VBA对象以获取键/属性。
如果我的解析javascript函数可以触发VBA函数或sub,那就太好了。
如果要在的基础上构建ScriptControl,则可以添加一些帮助程序方法以获取所需的信息。该JScriptTypeInfo对象有点不幸:它包含所有相关信息(如您在“ 监视” 窗口中看到的那样),但似乎无法使用VBA来实现。但是,JavaScript引擎可以帮助我们:
ScriptControl
JScriptTypeInfo
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
一些注意事项:
For Each ... Next
GetKeys
GetProperty
GetObjectProperty
length
0
Item 0
1
Item 1
jsonObject.property
InitScriptEngine