Excel VBA：解析的 JSON 对象循环

Question

提问by rr789

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).

下面的每个示例...从解析的 JSON 字符串循环遍历对象会返回错误“对象不支持此属性或方法”。谁能建议如何使这项工作？非常感谢（在问这里之前，我花了 6 个小时寻找答案）。

Function to parse JSON string into object (this works OK).

将 JSON 字符串解析为对象的函数（这工作正常）。

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-jsonWasn't able to get the example working.
-VBJSONThere's no vba script included (this might work but don't know how to load it into Excel and there is minimum documentation).

- vba-json无法让示例工作。
- VBJSON不包含 vba 脚本（这可能有效，但不知道如何将其加载到 Excel 中，并且文档最少）。

Also, Is it possible to access Multidimensional parsed JSON arrays? Just getting a basic key/value array loop working would be great (sorry if asking too much). Thanks.

另外，是否可以访问多维解析的 JSON 数组？只是让一个基本的键/值数组循环工作会很棒（对不起，如果问太多了）。谢谢。

Edit: Here are two working examples using the vba-json library. The question above is still a mystery though...

编辑：这里有两个使用 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

Answer 1

回答by Codo

The JScriptTypeInfoobject is a bit unfortunate: it contains all the relevant information (as you can see in the Watchwindow) but it seems impossible to get at it with VBA.

该JScriptTypeInfo对象有点不幸：它包含所有相关信息（如您在Watch窗口中所见），但似乎无法使用 VBA 获得它。

If the JScriptTypeInfoinstance refers to a Javascript object, For Each ... Nextwon't work. However, it does work if it refers to a Javascript array (see GetKeysfunction below).

如果JScriptTypeInfo实例引用 Javascript 对象，For Each ... Next则不起作用。但是，如果它引用 Javascript 数组，它确实可以工作（请参阅GetKeys下面的函数）。

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.

因此，解决方法是再次使用 Javascript 引擎来获取我们无法使用 VBA 获取的信息。首先，有一个函数可以获取 Javascript 对象的键。

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.

一旦您知道密钥，下一个问题就是访问属性。如果密钥的名称仅在运行时已知，则 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

Note:

笔记：

The code uses early binding. So you have to add a reference to "Microsoft Script Control 1.0".
You have to call InitScriptEngineonce before using the other functions to do some basic initialization.

该代码使用早期绑定。所以你必须添加对“Microsoft Script Control 1.0”的引用。
InitScriptEngine在使用其他函数进行一些基本初始化之前，您必须调用一次。

Answer 2

回答by S Meaden

Codo's answer is great and forms the backbone of a solution.

Codo 的回答很棒，是解决方案的支柱。

However, did you know VBA's CallByNamegets you pretty far in querying a JSON structure. I've just written a solution over at Google Places Details to Excel with VBAfor an example.

但是，您知道 VBA 的CallByName可以让您在查询 JSON 结构方面走得更远。我刚刚在Google Places Details to Excel with VBA 上写了一个解决方案作为示例。

Actually just rewritten it without managing to use the functions adding to ScriptEngine as per this example. I achieved looping through an array with CallByName only.

实际上只是重写了它，而没有设法使用根据此示例添加到 ScriptEngine 的函数。我仅使用 CallByName 实现了对数组的循环。

So some sample code to illustrate

所以一些示例代码来说明

'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

And it does sub-objects (nested objects) as well see Google Maps example at Google Places Details to Excel with VBA

它也做子对象（嵌套对象）以及使用 VBA在Google Places Details to Excel 中查看 Google Maps 示例

EDIT: Don't use Eval, try to parse JSON safer, see this blog post

编辑：不要使用 Eval，尝试更安全地解析 JSON，请参阅此博客文章

Answer 3

回答by ozmike

Super Simple answer - through the power of OO (or is it javascript ;) You can add the item(n) method you always wanted!

超级简单的答案 - 通过 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

Answer 4

回答by SIM

As Json is nothing but strings so it can easily be handled if we can manipulate it the right way, no matter how complex the structure is. I don't think it is necessary to use any external library or converter to do the trick. Here is an example where I've parsed json data using string manipulation.

因为 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

Answer 5

回答by shafiqul haque

So its 2020 and yet due to lack of an end-to-end solution, I stumbled upon this thread. It did help but if we need to access the data without Keys at runtime dynamically, the answers above, still need a few more tweaks to get the desired data.

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

I finally came up with a function to have an end-to-end neat solution to this JSON parsing problem in VBA. What this function does is, it takes a JSON string(nested to any level) as input and returns a formatted 2-dimensional array. This array could further easily be moved to Worksheet by plain i/j loops or could be played around conveniently due to its easy index-based accessibility.

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

Sample input-output

样本输入输出

The function is saved in a JSON2Array.bas file at my Github repo. JSON2Array-VB

该函数保存在我的 Github 存储库中的 JSON2Array.bas 文件中。 JSON2Array-VB

A demo usage subroutine is also included in the .bas file. Please download and import the file in your VBA modules. I hope it helps.

.bas 文件中还包含一个演示使用子例程。请下载并导入您的 VBA 模块中的文件。我希望它有帮助。

Answer 6

回答by Lionel T.

I know it's late, but for those who doesn't know how to use VBJSON, you just have to:

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

1) Import JSON.bas into your project (Open VBA Editor, Alt + F11; File > Import File)

1) 将 JSON.bas 导入您的项目（打开 VBA 编辑器，Alt + F11；文件 > 导入文件）

2) Add Dictionary reference/class For Windows-only, include a reference to "Microsoft Scripting Runtime"

2) 添加字典参考/类仅适用于 Windows，包括对“Microsoft Scripting Runtime”的参考

You can also use the VBA-JSONthe same way, which is specific for VBA instead of VB6 and has all the documentation.

您还可以以相同的方式使用VBA-JSON，它是 VBA 专用的，而不是 VB6 专用的，并且包含所有文档。

Excel VBA：解析的 JSON 对象循环

提问by rr789

回答by Codo

回答by S Meaden

回答by ozmike

回答by SIM

回答by shafiqul haque

回答by Lionel T.

相关推荐

最近更新

标签

Excel VBA：解析的 JSON 对象循环

提问by rr789

回答by Codo

回答by S Meaden

回答by ozmike

回答by SIM

回答by shafiqul haque

回答by Lionel T.

相关推荐

如何使用 Swift 格式化 JSON 日期字符串？

Ruby on Rails JSON.parse 意外令牌错误

json extjs 存储错误处理

如何在 Swift 中将数组保存为 json 文件？

相关推荐

最近更新

标签