以下示例...从解析的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
答案 0 :(得分:30)
JScriptTypeInfo
对象有点不幸:它包含所有相关信息(正如您在 Watch 窗口中看到的那样),但似乎无法通过VBA获取它。< / p>
如果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
注意:
InitScriptEngine
。答案 1 :(得分:5)
Codo的答案很棒,是解决方案的支柱。
但是,您是否知道VBA的 CallByName 让您在查询JSON结构方面取得了相当大的进展。我刚刚在Google Places Details to Excel with VBA处编写了一个解决方案。
实际上只是重写了它而没有按照这个例子使用添加到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 to Excel with VBA上的Google Maps示例
答案 2 :(得分:3)
超级简单的回答 - 通过OO的力量(或者是javascript;) 您可以添加您想要的item(n)方法!
<强> my full answer here 强>
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
答案 3 :(得分:2)
因此在2020年,但由于缺乏端到端解决方案,我偶然发现了这个线程。它确实有帮助,但是如果我们需要在运行时动态地访问没有Keys的数据,那么上面的答案仍然需要进行一些调整才能获得所需的数据。
我终于想出了一个函数,可以针对VBA中的JSON解析问题提供端到端的整洁解决方案。此函数的作用是,将JSON字符串(嵌套到任何级别)作为输入,并返回格式化的二维数组。该数组可以通过普通的i / j循环轻松地移动到工作表,或者由于其基于索引的易访问性而可以方便地播放。
该函数保存在我的Github存储库中的JSON2Array.bas文件中。 JSON2Array-VB
.bas文件中还包含一个演示用法子例程。 请下载文件并将其导入您的VBA模块。 希望对您有所帮助。
答案 4 :(得分:1)
由于Json只不过是字符串所以如果我们能够以正确的方式操作它,它就可以轻松处理,无论结构多么复杂。我不认为有必要使用任何外部库或转换器来完成这个技巧。这是我使用字符串操作解析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
答案 5 :(得分:0)