使用excel vba修改json查询

时间:2018-10-14 13:00:38

标签: json excel vba excel-vba web-scraping

我需要使用excel vba修改Json

我希望能够使用VBA动态更改邮政编码或将此部分指向工作簿中的单元格

let
    Source = Json.Document(Web.Contents("https://api.propertydata.co.uk/prices?key=HEZEHOR0NC&postcode=SW161AG&bedrooms=4")),
    data = Source[data],
    #"Converted to Table" = Record.ToTable(data)
in
    #"Converted to Table"

1 个答案:

答案 0 :(得分:1)

这假定JSON响应内的对象类型集一致,并使用XMLHTTP请求获取JSON响应。这使您可以使用在邮政编码中包含的URL查询字符串。测试了几个邮政编码。它使用JSON parser处理JSON。导入JSONConverter.bas后,您需要进入VBE>工具>引用,并添加对Microsoft脚本运行时的引用。与您当前的M代码不同,此操​​作将列出pc_ranges值,而不仅仅是返回一个对象。

注意:您需要用API密钥替换yourKeyGoesHere

Option Explicit
Public r As Long
Public Sub GetInfoFromSheet()
    Application.ScreenUpdating = False
    Dim jsonStr As String, json As Object, item As Object, output As String
    Dim URL As String, postCode As String
    postCode = "SO419AA" '"SW161AG"
    URL = "https://api.propertydata.co.uk/prices?key=yourKeyGoesHere&postcode=" & postCode & "&bedrooms=4"
    r = 1

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        jsonStr = StrConv(.responseBody, vbUnicode)
    End With
    Set json = JsonConverter.ParseJson(jsonStr)
    emptyObject json
    Application.ScreenUpdating = True
End Sub
Public Sub emptyObject(ByVal json As Object)
    Dim key As Variant, item As Variant
    With ThisWorkbook.Worksheets("Sheet1")
        For Each key In json
            Select Case TypeName(json(key))
            Case "String", "Double"
                .Cells(r, 1) = key
                .Cells(r, 2) = json(key)
                r = r + 1
            Case "Dictionary"
                emptyObject json(key)
            Case "Collection"
                For Each item In json(key)
                    Select Case TypeName(item)
                    Case "Double"
                        .Cells(r, 1) = key
                        .Cells(r, 2) = item
                        r = r + 1
                    Case "Dictionary"
                        emptyObject item
                    End Select
                Next
            End Select
        Next
    End With
End Sub