Excel VBA：parsing的JSON对象循环
下面的示例…从parsing的JSONstring中循环一个对象返回一个错误“对象不支持此属性或方法”。 任何人都可以build议如何使这项工作？ 非常感谢（我在这里问了6个小时之前寻找答案）。
将JSONstringparsing到对象中的function（此工作正常）。
Function jsonDecode(jsonString As Variant) Set sc = CreateObject("ScriptControl"): sc.Language = "JScript" Set jsonDecode = sc.Eval("(" + jsonString + ")") End Function 循环通过parsing对象返回错误“对象不支持此属性或方法”。
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对象有点不幸：它包含了所有的相关信息（正如你在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一次。
超级简单的答案 – 通过面向对象的力量（或者它的JavaScript;）您可以添加您一直想要的项目（n）方法！
我的完整答案在这里
Private ScriptEngine As ScriptControl Public Sub InitScriptEngine() Set ScriptEngine = New ScriptControl ScriptEngine.Language = "JScript" ScriptEngine.AddCode "Object.prototype.myitem=function( i ) { return this[i] } ; " Set foo = ScriptEngine.Eval("(" + "[ 1234, 2345 ]" + ")") ' JSON array Debug.Print foo.myitem(1) ' method case sensitive! Set foo = ScriptEngine.Eval("(" + "{ ""key1"":23 , ""key2"":2345 }" + ")") ' JSON key value Debug.Print foo.myitem("key1") ' WTF End Sub
科多的答案很好，构成了解决scheme的中坚力量。
但是，您是否知道VBA的CallByName在查询JSON结构方面得到了很大的帮助。 我刚刚使用VBA将“Google地方资料详细信息”的解决scheme写入了Excel 。
实际上只是重写了它，没有pipe理使用添加到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
而且它还可以执行子对象（嵌套对象），以及使用VBA将Google地图详细信息中的 Google地图示例显示为Excel
我知道这很晚了，但对于那些不知道如何使用VBJSON的人来说 ，你只需要：
1）将JSON.bas导入到您的项目（打开VBA编辑器，Alt + F11;文件>导入文件）
2）添加词典参考/类仅用于Windows，包含对“Microsoft脚本运行时”
你也可以用相同的方法使用VBA-JSON ，这是特定于VBA而不是VB6的，并且具有所有的文档。
由于Json只是string，所以无论结构多么复杂，如果我们可以正确地操作它，它就可以很容易地处理。 我不认为有必要使用任何外部库或转换器来伎俩。 这是一个例子，我已经使用string操作parsing了json数据。
Sub Json_data() Const URL = "https://api.redmart.com/v1.5.8/catalog/search?extent=2&pageSize=6&sort=1&category=bakery" Dim http As New XMLHTTP60, html As New HTMLDocument Dim str As Variant With http .Open "GET", URL, False .send str = Split(.responseText, "category_tags"":") End With On Error Resume Next y = UBound(str) For i = 1 To y Cells(i, 1) = Split(Split(str(i), "title"":""")(1), """")(0) Cells(i, 2) = Split(Split(str(i), "sku"":""")(1), """")(0) Cells(i, 3) = Split(Split(str(i), "price"":")(1), ",")(0) Cells(i, 4) = Split(Split(str(i), "desc"":""")(1), """")(0) Next i End Sub
