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

我感兴趣的字段：

一片零散的chunck：

"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结构，可以看到它如下（样本）

我们在字典中返回的信息是在＆＃34;功能＆＃34;所以我们最初可以用：
来提取
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)添加到代码中以便为您清楚，但已删除了＆＃34; Hood＆＃34;在我看来，在输出中，我的运行前缀看起来更干净。

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内置项中提供，因此您必须使用{{1}处理它们功能就像我在下面做的那样。它比从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

从json响应中收集少量字段

2 个答案: