Excel VBA:解析JSON对象循环

下面的例子…从解析过的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

p。我已经查看了这些库:

-vba-json无法使示例工作。
没有包含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实例引用一个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一次。

Codo的回答很好，构成了解决方案的主干。

然而，你知道VBA的CallByName让你在查询JSON结构方面走得很远吗?我刚刚写了一个解决方案在谷歌地点详细信息Excel与VBA为例。

实际上只是重写了它，而没有按照这个例子管理使用添加到ScriptEngine的函数。我实现了循环通过一个只有CallByName的数组。

下面是一些示例代码来说明

'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:WindowsSysWOW64msscript.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

它做子对象(嵌套对象)，以及看到谷歌地图的例子在谷歌位置详细信息Excel与VBA

编辑:不要使用Eval，试着更安全地解析JSON，看这个博客文章

超级简单的答案-通过OO的力量(或者是javascript;)您可以添加您一直想要的item(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

由于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

所以它是2020年，但由于缺乏端到端解决方案，我偶然发现了这个线程。它确实有帮助，但如果我们需要在运行时动态地访问没有键的数据，上面的答案仍然需要更多的调整来获得所需的数据。

我终于想出了一个函数，有一个端到端整洁的解决方案，这个JSON解析问题在VBA。这个函数的作用是，它接受一个JSON字符串(嵌套到任何级别)作为输入，并返回一个格式化的二维数组。这个数组可以通过普通的i/j循环进一步轻松地移动到工作表中，或者由于其简单的基于索引的可访问性，可以方便地进行播放。

样本输入输出

函数保存在JSON2Array中。在我的Github回购文件。JSON2Array-VB

.bas文件中还包含一个演示使用子例程。请在您的VBA模块中下载并导入该文件。

我知道已经很晚了，但是对于那些不知道如何使用VBJSON的人，你只需要:

1)导入JSON。已进入您的项目(打开VBA编辑器，Alt + F11;文件>导入文件)

2)添加Dictionary引用/类仅对于windows，包含对"Microsoft Scripting Runtime"的引用

你也可以用同样的方式使用VBA- json，它是针对VBA而不是VB6的，并且有所有的文档。

相关内容

最新更新

热门标签：