VBA-Json解析嵌套Json [英] VBA-Json Parse Nested Json
问题描述
感谢@QHarr与我一起解决这个问题！
Thank you to @QHarr for working on this with me!
我的目标是从订单"中获取每个嵌套类别的值
My goal is to grab the values for each of the nested categories from "orders"
我的json:
{
"total": 14,
"_links": {
"next": {
"href": "/api/my/orders/selling/all?page=2&per_page=1"
}
},
"orders": [
{
"amount_product": {
"amount": "0.01",
"currency": "USD",
"symbol": "$"
},
"amount_product_subtotal": {
"amount": "0.01",
"currency": "USD",
"symbol": "$"
},
"shipping": {
"amount": "0.00",
"currency": "USD",
"symbol": "$"
},
"amount_tax": {
"amount": "0.00",
"currency": "USD",
"symbol": "$"
},
"total": {
"amount": "0.01",
"currency": "USD",
"symbol": "$"
},
"buyer_name": "Some Buyer",
"created_at": "2015-02-03T04:38:03-06:00",
"order_number": "434114",
"needs_feedback_for_buyer": false,
"needs_feedback_for_seller": false,
"order_type": "instant",
"paid_at": "2015-02-03T04:38:04-06:00",
"quantity": 1,
"shipping_address": {
"name": "Some Buyer",
"street_address": "1234 Main St",
"extended_address": "",
"locality": "Chicagoj",
"region": "IL",
"postal_code": "60076",
"country_code": "US",
"phone": "1231231234"
},
"local_pickup": false,
"shop_name": "Some Seller",
"status": "refunded",
"title": "DOD Stereo Chorus Extreme X GFX64",
"updated_at": "2015-03-06T11:59:27-06:00",
"payment_method": "direct_checkout",
"_links": {
"photo": {
"href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_192,w_192/v1386717988/h1zpe0sii9my0xm55htd.jpg"
},
"feedback_for_buyer": {
"href": "/api/orders/434114/feedback/buyer"
},
"feedback_for_seller": {
"href": "/api/orders/434114/feedback/seller"
},
"listing": {
"href": "/api/listings/47096"
},
"start_conversation": {
"href": "/api/my/conversations?listing_id=47096&recipient_id=302456"
},
"self": {
"href": "/api/my/orders/selling/434114"
},
"mark_picked_up": {
"href": "/api/my/orders/selling/434114/mark_picked_up"
},
"ship": {
"href": "/api/my/orders/selling/434114/ship"
},
"contact_buyer": {
"web": {
"href": "https://reverb.com/my/messages/new?item=47096-dod-stereo-chorus-extreme-x-gfx64&to=302456-yan-p-5"
}
}
},
"photos": [
{
"_links": {
"large_crop": {
"href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_640,q_85,w_640/v1386717988/h1zpe0sii9my0xm55htd.jpg"
},
"small_crop": {
"href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_296,q_85,w_296/v1386717988/h1zpe0sii9my0xm55htd.jpg"
},
"full": {
"href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_limit,f_auto,fl_progressive,h_1136,q_75,w_640/v1386717988/h1zpe0sii9my0xm55htd.jpg"
},
"thumbnail": {
"href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_192,w_192/v1386717988/h1zpe0sii9my0xm55htd.jpg"
}
}
}
],
"sku": "rev-47096",
"selling_fee": {
"amount": "0.00",
"currency": "USD",
"symbol": "$"
},
"direct_checkout_payout": {
"amount": "-0.24",
"currency": "USD",
"symbol": "$"
}
}
]
}
如果我有一个很好的例子说明如何处理嵌套数据，那么我可以使它正常工作.这是我当前的代码，不起作用...这是以下错误:此行上的对象不支持此属性或方法":对于Orders("amount_product")中的每个Amount_Product.我期望能够提取每个amount_product项目"的值并将其推入变量中，以便随后将它们推入表中.
If I have one good example of how to work with the nested data I am sure I can get this to work. This is my current code, it doesn't work... this is the error- "the object doesn't support this property or method" on this line: For Each Amount_Product In Orders("amount_product"). What I am expecting is to be able to extract the value of each of the amount_product "items" and push them into variables so that I can then push them into a table.
Dim Json As Object
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Dim Parsed As Dictionary
'set up variables to receive the values
Dim sAmount As String
Dim sCurrency As String
Dim sSymbol As String
'Read .json file
Set JsonTS = FSO.OpenTextFile("somefilepath.txt", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
'came from https://github.com/VBA-tools/VBA-JSON
Set Parsed = JsonConverter.ParseJson(JsonText)
Dim Values As Variant
Dim Orders As Dictionary
Dim NestedValue As Dictionary
Dim i As Long
i = 0
For Each Orders In Parsed("orders")
For Each NestedValue In Orders("amount_product")
sAmount = (Values(i, 0) = NestedValue("amount"))
sCurrency = (Values(i, 1) = NestedValue("currency"))
sSymbol = (Values(i, 2) = NestedValue("symbol"))
i = i + 1
Next NestedValue
Next Orders
我也尝试了这一点-根据一些我发现的代码示例，这也不起作用:
I also tried this- based on some examples of code I have found, this doesn't work either:
For Each NestedValue In Parsed("orders")(1)("amount_product")
sAmount = (Values(i, 0) = NestedValue("amount"))
sCurrency = (Values(i, 1) = NestedValue("currency"))
sSymbol = (Values(i, 2) = NestedValue("symbol"))
i = i + 1
Next NestedValue
我尝试使用@TimWilliams的 VBA解析嵌套JSON 示例，但在调整它以与我的Json一起使用.同样的错误，对于Parsed("orders")(1)("amount_product")()中的每个NestedValue"行上的对象不支持此属性或方法"
I tried using this VBA Parse Nested JSON example by @TimWilliams but was not successful in tweaking it to work with my Json. Same error, "object doesn't support this property or method" on the line "For Each NestedValue In Parsed("orders")(1)("amount_product")"
推荐答案
确定解决了(糟糕....我认为！).因此，这里有两个版本处理相同的JSON.
Ok solved (Oops....I think!). So, here are two versions dealing with the same JSON.
版本1:一个简单的示例，向您展示如何获取所追求的Amount_Product值.不是最容易阅读的语法，但是我在版本2中给出了冗长的描述/语法.
Version 1: A simple example showing you how to get the Amount_Product values you were after. Not the easiest to read syntax, but I have given the lengthy descriptions/syntax in version 2.
版本2:从JSON中提取所有值.
其他设置要求:
1)VBE>工具>参考中对MS脚本运行时的参考
1) Reference required to MS Scripting Runtime in VBE > Tools > References
2) Tim Hall
在每个阶段，我都使用TypeName(object)来了解从JSON返回的对象.我把其中一些留了下来(注释为Debug.Print语句)，以便您了解每个阶段的情况.
I used TypeName(object) , at each stage, to understand which objects were being returned from the JSON. I have left some of these in (commented out as Debug.Print statements) so you have an idea what is going on at each stage.
1)JsonConverter.ParseJson(JsonText)将字典返回到Parsed.
2)Parsed("orders")返回一个包含单个词典的集合，即initialCollection(1)
2) Parsed("orders") returns a collection which holds a single dictionary i.e. initialCollection(1)
3)字典包含各种各样的对象，也许这很令人困惑.
3) That dictionary holds a variety of objects which is perhaps what is rather confusing.
如果运行以下命令，请查看字典中的对象:
If you run the following, to look at the objects in the dictionary:
Debug.Print TypeName(initialDict(key))
您发现这是一部繁忙的小词典.它包含以下内容:
You discover what a busy little dictionary it is. It hosts the following:
- 布尔值* 3
- 收藏* 1
- 字典* 9
- 双* 1
- 字符串* 11
因此，您当然当然会通过这些结构来深入研究嵌套的更深层次.根据数据类型，我通过Select Case完成了不同的处理.我试图使术语保持简单明了.
And so of course you keep delving into deeper levels of the nesting via these structures. The different handling, according to datatype, I have done via Select Case. I have tried to keep the terminology fairly straight forward.
如何使用在线JSON解析器检查结构:
因此，有许多在线JSON解析器.
您在左侧窗口(我给出的示例)中弹出代码，右侧窗口显示评估结果:
You pop your code in the left window (of the example I have given) and the right window shows the evaluation:
如果您看到初始的红色"["；这是您通过Parsed("orders")获取的集合对象.
If you look at the initial red "[" ; this is the collection object you are getting with Parsed("orders").
然后，您可以在"amount_product"之前看到第一个"{"，这是您在馆藏中的第一个词典.
Then you can see the first "{" before the "amount_product" which is your first dictionary within the collection.
在其中，与"amount_product" id关联的是下一个字典，在该字典中您可以看到下一个"{"
And within that, associated with "amount_product" id, is the next dictionary where you see the next "{"
因此，您知道必须获取集合，然后可能要遍历两个字典来获取您感兴趣的第一组值.
So you know you have to get the collection and then potentially iterate over two dictionaries to get the first set of values you were interested in.
在第一个代码示例中，我使用了Parsed("orders")(1)("amount_product").Keys的快捷方式来访问此内部字典以进行迭代.
I used a shortcut with Parsed("orders")(1)("amount_product").Keys ,in the first code example, to get to this inner dictionary to iterate over.
结果:
版本1(简单):
Option Explicit
Public Sub test1()
Dim Json As Object
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
Dim Parsed As Dictionary 'or As Object if not including reference to scripting runtime reference in library
Set Parsed = JsonConverter.ParseJson(JsonText)
Dim key As Variant
Dim sAmount As String 'Assume you will keep these as strings?
Dim sCurrency As String
Dim sSymbol As String
For Each key In Parsed("orders")(1)("amount_product").Keys
Dim currentString As String
currentString = Parsed("orders")(1)("amount_product")(key)
Select Case key
Case "amount"
sAmount = currentString
Case "currency"
sCurrency = currentString
Case "symbol"
sSymbol = currentString
End Select
Debug.Print key & ": " & currentString
Next key
End Sub
版本2:抓住所有内容.更具描述性.
Option Explicit
Sub test2()
Dim Json As Object
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading) 'change as appropriate
JsonText = JsonTS.ReadAll
JsonTS.Close
Dim Parsed As Dictionary
Set Parsed = JsonConverter.ParseJson(JsonText)
Dim initialCollection As Collection
Set initialCollection = Parsed("orders")
' Debug.Print initialCollection.Count ' 1 item which is a dictionary
Dim initialDict As Dictionary
Set initialDict = initialCollection(1)
Dim key As Variant
Dim dataStructure As String
For Each key In initialDict.Keys
dataStructure = TypeName(initialDict(key))
Select Case dataStructure
Case "Dictionary"
Dim Key1 As Variant
For Each Key1 In initialDict(key).Keys
Select Case TypeName(initialDict(key)(Key1))
Case "String"
Debug.Print key & " " & Key1 & " " & initialDict(key)(Key1) 'amount/currency/symbol
Case "Dictionary"
Dim Key2 As Variant
For Each Key2 In initialDict(key)(Key1).Keys
'Debug.Print TypeName(initialDict(key)(Key1)(Key2)) 'strings and one dict
Select Case TypeName(initialDict(key)(Key1)(Key2))
Case "String"
Debug.Print key & " " & Key1 & " " & Key2 & " " & initialDict(key)(Key1)(Key2)
Case "Dictionary"
Dim Key3 As Variant
For Each Key3 In initialDict(key)(Key1)(Key2).Keys
'Debug.Print TypeName(initialDict(key)(Key1)(Key2)(Key3)) 'string only
Debug.Print initialDict(key)(Key1)(Key2)(Key3)
Next Key3
End Select
Next Key2
Case Else
MsgBox "Oops I missed this one"
End Select
Next Key1
Case "String", "Boolean", "Double"
Debug.Print key & " : " & initialDict(key)
Case "Collection"
'Debug.Print TypeName(initialDict(key)(1)) 'returns 1 Dict
Dim Key4 As Variant
For Each Key4 In initialDict(key)(1).Keys 'Debug.Print TypeName(initialDict(key)(1)(Key4)) 'returns a dictionary
Dim Key5 As Variant
For Each Key5 In initialDict(key)(1)(Key4).Keys ' Debug.Print TypeName(initialDict(key)(1)(Key4)(Key5)) returns 4 dictionaries
Dim Key6 As Variant
For Each Key6 In initialDict(key)(1)(Key4)(Key5).Keys 'returns string
Debug.Print key & " " & Key4 & " " & Key5 & " " & Key6 & " " & initialDict(key)(1)(Key4)(Key5)(Key6)
Next Key6
Next Key5
Next Key4
Case Else
MsgBox "Oops I missed this one!"
End Select
Next key
End Sub
最终观察:
为了保持一致并帮助说明正在发生的事情，我添加了所有.Keys，但是当在For Each字典循环中进行迭代时，不必添加.Keys，如图所示在下面的测试和嵌入的gif中:
To be consistent, and to aid demonstrating what is going on, I have added all the .Keys, but it is unnecessary, when iterating in a For Each Loop over a Dictionary, to put .Keys, as shown in test below and in the embedded gif:
Option Explicit
Private Sub test()
Dim testDict As Dictionary
Set testDict = New Dictionary
testDict.Add "A", 1
testDict.Add "B", 2
Dim key As Variant
For Each key In testDict
Debug.Print key & ":" & testDict(key)
Next key
End Sub
例如:
For Each key In initialDict.Keys => For Each key In initialDict
这篇关于VBA-Json解析嵌套Json的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
