从 json 响应中收集几个字段

Question

我在 vba 中编写了一个脚本来从包含 json 数据的链接中获取一些字段。由于我从未将 json 与 vba 结合使用，因此我不知道我追求哪种方式。我听说电源查询是一种选择，但这对我来说很难应付。关于如何获得下图中描述的这些字段的任何替代解决方案。

这是我试过的：

Sub CollectInformation()
    Dim ReqHttp As New XMLHTTP60, Ohtml As New HTMLDocument
    weblink = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"

    With ReqHttp
        .Open "GET", weblink, False
        .send
        Ohtml.body.innerHTML = .responseText
        MsgBox .responseText  ''I can see the valid response in the messagebox
   End With
End Sub

我感兴趣的领域：

一块散落的大块：

"features":[{"type":"Feature","properties":{"HOOD":"Trinity-Bellwoods","center":"43.65241687364585 -79.41651445205076","streetview":{"lat":43.6452785,"lng":-79.4131849,"heading":-25.74,"pitch":"-1.34"},"rankings":{"Housing":19.7,"Crime":39.4,"Transit":73.9,"Shopping":88,"Health":33.1,"Entertainment":97.9,"Community":61.3,"Diversity":9.9,"Schools":64.8,"Employment":73.2},"irank":42,"urank":42},

为了更清楚：

密钥是"HOOD","Housing","Crime","Shopping". 我想得到他们的价值观。

Answer 1

这样就可以了

Option Explicit

Sub GetInfo()
    '"HOOD","Housing","Crime","Shopping"
    Dim strURL As String, strJSON As String, http As Object, json As Object

    strURL = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", strURL, False
    http.send
    strJSON = http.responseText

    Set json = JsonConverter.ParseJson(strJSON)("features")

    Dim i As Long, key As Variant
    For i = 1 To json.count
        For Each key In json(i)
            Select Case True
            Case key = "properties"
                Dim a As Object, key2 As Variant
                Set a = json(i)(key)
                For Each key2 In a.Keys
                    Select Case key2
                    Case "HOOD"
                        Debug.Print "Hood" & " " & a(key2)
                    Case "rankings"
                        Dim b As Object
                        Set b = a(key2)
                        Debug.Print "Housing" & " :  " & b("Housing")
                        Debug.Print "Crime" & " :  " & b("Crime")
                        Debug.Print "Shopping" & " :  " & b("Shopping")
                    End Select
                Next key2
            End Select
        Next key
    Next i
End Sub

---

示例输出：

---

注意事项：

如果您检查 JSON 结构，您可以看到如下（示例）

我们想要返回的字典中的信息在“特征”内，因此我们可以通过以下方式提取它：

Set json = JsonConverter.ParseJson(strJSON)("features")

这会产生一个字典集合（参见开头的"["）。在这些字典中，每当出现键 "properties" 时，我们都会感兴趣，因为它们包含感兴趣的项目。我们可以使用Select Case 语句来过滤该键：

Select Case True
Case key = "properties"

然后我们将它设置为一个变量，这又是一个字典：

Set a = json(i)(key)

从 JSON 图像中我们可以再次看到我们对特定键感兴趣：HOOD 和 rankings；为了获得感兴趣的项目 ("HOOD","Housing","Crime","Shopping") 。

HOOD 和 rankings 返回不同的datatypes。

HOOD 返回一个字符串：

所以我们可以直接使用关联的键访问所需的值：

a(key2)

我已将Debug.Print "Hood" & " " & a(key2) 添加到代码中以使您更清楚，但在我看来，我在输出中删除了运行时的“Hood”前缀，因为它看起来更干净。

rankings返回字典，见"{"：

所以，如果我们最初将它设置为一个变量：

Set b = a(key2)

我们可以避免循环键并直接通过感兴趣的键访问，即：

Debug.Print "Housing" & " :  " & b("Housing")
Debug.Print "Crime" & " :  " & b("Crime")
Debug.Print "Shopping" & " :  " & b("Shopping")

我添加了一些描述符文本，使输出更清晰。

Answer 2

您不需要任何外部转换器来处理 json 数据。那里已经有一种强大的方法。要运行脚本，除了为xmlhttp 请求所做的之外，您甚至不需要向参考库中添加任何内容。要获得相应的值，您需要使用 . 点运算符来调用它的键。但是，在某些情况下，您可能会发现一些相互矛盾的名称，例如 Status、Ranking、Properties，它们已经在 vba 内置项目中可用，因此您必须使用 CallByName 函数来处理它们，就像我在下面所做的那样.它比从html elements 拉出任何常规网页的项目更容易（使用它）。

这是您获得所需物品的方式：

Sub FetchJsonInfo()
    Const URL As String = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
    Dim Http As New XMLHTTP60, SC As Object, elem As Object
    Dim resobject As Object, post As Object, R&

    Set SC = CreateObject("ScriptControl")
    SC.Language = "JScript"

    With Http
        .Open "GET", URL, False
        .send
        Set resobject = SC.Eval("(" + .responseText + ")")
        .abort

        For Each post In resobject.features
            Set elem = CallByName(post, "properties", VbGet)
            R = R + 1: Cells(R, 1) = elem.HOOD
            Cells(R, 2) = elem.rankings.Housing
            Cells(R, 3) = elem.rankings.Crime
            Cells(R, 4) = elem.rankings.Shopping
        Next post
   End With
End Sub

添加到库的参考：

Microsoft XML, v6.0