使用VBA解析JSON出现问题

Question

我可以从网络查询中获得一个看起来是有效的JSON字符串，但是我无论如何都无法正确设置项目。需要确认我没有疯掉...

'Call for available reports

Dim URLReporta As String
Dim JSONa As Object
Dim var As Object  
Set myrequesta = CreateObject("winhttp.winhttprequest.5.1")
URLReporta = ("https://secure.saashr.com:443/ta/rest/v1/reports?type=Saved&company%3shortname=" & Company)
myrequesta.Open "GET", URLReporta, False
myrequesta.setRequestHeader "Accept", "application/json"
myrequesta.setRequestHeader "Authentication", "Bearer " & Token
myrequesta.setRequestHeader "Content-Type", "application/json"
myrequesta.Send
Set JSONa = JsonConverter.ParseJson(myrequesta.responseText)
Set var = JSONa("SavedName")
Debug.Print var.Count

我在Set var = JSONa("SavedName")这一行遇到了错误：

运行时错误 '424': 需要对象

myrequesta.responseText的值如下：

{"reports":[{"SavedName":"今年","SettingId":18959322},{"SavedName":"请假请求","SettingId":18960210},{"SavedName":"计算工时汇总","SettingId":18960209},{"SavedName":"值班表","SettingId":18960211},{"SavedName":"E/D/T","SettingId":18823042},{"SavedName":"TestZDR","SettingId":18957188}]}

- Zach Rochon

---

我无法正确设置项目...设置哪些项目？你的错误是什么？你想解析什么？期望的输出是什么？简而言之，你的问题是什么？ - Parfait

你好像正在使用 https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas？ - ThunderFrame

我已更新上面的代码，但是出现了运行时错误 '424'：在行"Set var = JSONa("SavedName")"中需要对象。 - Zach Rochon

如果您的JSON字符串可以转换为XML结构，那么您就可以使用XPath表达式，例如//property[@name = "SavedName"]来获取表示“SavedName”属性的所有节点的集合。 - omegastripes

你知道ScriptControl.Eval("("+ json + ")" )可以解析对象，而且可以使用CallByName访问元素。请查看我的答案：http://stackoverflow.com/questions/37711034/in-excel-vba-on-windows-how-to-loop-through-a-json-array-parsed?noredirect=1&lq=1#answer-37711035 - S Meaden

Answer 1

JsonConverter.ParseJson函数返回的结构不是这样的。对于您特定的JSON，它包含3个级别： 根级对象只有一个属性reports，其中包含第二级数组，该数组又包含6个第三级对象，具有属性SavedName和SettingId。您正在尝试从根级对象获取第三级对象的属性值。 首先，您需要获取第二级数组，然后循环遍历其包含的对象，并检索这些对象的SavedName属性的值。以下是示例：

'Call for available reports

Dim URLReporta As String
Dim JSONa As Object
Dim var As Object
Dim rep As Variant
Set myrequesta = CreateObject("winhttp.winhttprequest.5.1")
URLReporta = ("https://secure.saashr.com:443/ta/rest/v1/reports?type=Saved&company%3shortname=" & Company)
myrequesta.Open "GET", URLReporta, False
myrequesta.setRequestHeader "Accept", "application/json"
myrequesta.setRequestHeader "Authentication", "Bearer " & Token
myrequesta.setRequestHeader "Content-Type", "application/json"
myrequesta.Send
Set JSONa = JsonConverter.ParseJson(myrequesta.responseText) ' root level object
Set var = JSONa("reports") ' second level array
For Each rep In var ' third level objects
    Debug.Print rep("SavedName") ' property "SavedName" value of current third level object
Next

这里是输出：

如果您只想获取报告数量，那么获取数组及其元素数量即可：

Debug.Print JSONa("reports").Count

- omegastripes

---

谢谢！这解开了那个解析器的工作原理。 - Zach Rochon

你知道ScriptControl.Eval("("+ json + ")" )可以解析对象，而且可以使用CallByName来访问元素。请看我的答案：http://stackoverflow.com/questions/37711034/in-excel-vba-on-windows-how-to-loop-through-a-json-array-parsed?noredirect=1&lq=1#answer-37711035 - S Meaden

@SMeaden 这种方法在某些情况下会使系统变得容易受到攻击（来自Web查询的恶意代码可能会被执行），请看看这个答案，特别是更新部分。 - omegastripes

Answer 2

JSON对象可以被看作是字典的集合。因此，您需要遍历内部值，如SavedName，以检索整个字典对象（所有SavedName值）或特定字符串值的索引位置（一个SavedName值）：

Public Sub GetJSONRequest()
    Dim jsonStr As String

    jsonStr = "{" _
         & "     ""reports"": [{" _
         & "         ""SavedName"": ""This Year""," _
         & "         ""SettingId"": 18959322" _
         & "     }, {" _
         & "         ""SavedName"": ""Time Off Requests""," _
         & "         ""SettingId"": 18960210" _
         & "     }, {" _
         & "         ""SavedName"": ""Calc Hours Summary""," _
         & "         ""SettingId"": 18960209" _
         & "     }, {" _
         & "         ""SavedName"": ""roster""," _
         & "         ""SettingId"": 18960211" _
         & "     }, {" _
         & "         ""SavedName"": ""E/D/T""," _
         & "         ""SettingId"": 18823042" _
         & "     }, {" _
         & "         ""SavedName"": ""TestZDR""," _
         & "         ""SettingId"": 18957188" _
         & "  }]" _
         & "  }"

    Dim JSONa As Object, element As Object, e As Variant, i As Variant, var As Variant

    Set JSONa = ParseJson(jsonStr)

    ' DICTIONARY OBJECT
    Set element = CreateObject("Scripting.Dictionary")
    Set element = JSONa("reports")

    ' OUTER DICTIONARY
    For Each e In element
        ' INNER COLLECTION OF DICTIONARIES
        For Each i In e
            Debug.Print i & " " & e(i)
        Next i
    Next e            

    ' STRING VALUE OF FIRST SAVEDNAME VALUE
    var = JSONa("reports")(1)("SavedName")
    Debug.Print var

    Set element = Nothing
    Set JSONa = Nothing
End Sub

输出

SavedName This Year
SettingId 18959322
SavedName Time Off Requests
SettingId 18960210
SavedName Calc Hours Summary
SettingId 18960209
SavedName roster
SettingId 18960211
SavedName E/D/T
SettingId 18823042
SavedName TestZDR
SettingId 18957188
This Year

- Parfait