json - Excel VBA 提取值 JSON URL

Question

在 Excel 中

我尝试提取这个值“45.33887499999999”

通过此 Google 网址“https://maps.googleapis.com/maps/api/geocode/json?address=bojon”(在示例中 Google 网址 +"=bojon"或 +"=VENICE%20BEACH% 20CA”)

使用此 VBA 代码:

Public Function LATITUDE(coord As String)
    Dim firstVal As String
    firstVal = "https://maps.googleapis.com/maps/api/geocode/json?address="
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(coord, " ", "+")
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responseText, """location"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """lat"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(Index).SubMatches(0), ".", Application.International(xlListSeparator))
    LATITUDE = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    LATITUDE = -1
End Function

但此代码仅提取“45”，而不提取“45.33887499999999”

我尝试更改 regex.Pattern = """lat"".*?([0-9]+)"

但我还没有找到解决办法

<小时/>

最后，我想从此 URL 中提取具有 3 个不同公式(由 VBA 代码创建)的 3 个值

Google 网址 +“=bojon”

在这些行中

     "formatted_address" : "30010 Bojon VE, Italia",
     "geometry" : {
        "location" : {
           "lat" : 45.33887499999999,
           "lng" : 12.06598

在 A1 单元格中:“bojon”

=GOOGDRESS(A1) 结果 =“30010 Bojon VE，意大利”

=纬度(A1) 结果 = "45.33887499999999"

=经度(A1) 结果 = "12.06598"

<小时/>

另一个例子:

Google 网址 +“=VENICE%20BEACH%20CA”

     "formatted_address" : "Venice Beach, California, Stati Uniti",
     "geometry" : {
        "bounds" : {
           "northeast" : {
              "lat" : 33.996311,
              "lng" : -118.4561299
           },
           "southwest" : {
              "lat" : 33.9636437,
              "lng" : -118.4835886
           }
        },
        "location" : {
           "lat" : 33.9936153,
           "lng" : -118.4799099

=GOOGDRESS(A1) 结果 =“威尼斯海滩，加利福尼亚州，Stati Uniti”

=纬度(A1) 结果 = "33.9936153"

=经度(A1) 结果 = "-118.4799099"

<小时/>

谁能帮我吗？

Answer 1

使用脚本控件解析 JSON 并缓存 json 响应以避免不必要的 XMLHTTP 调用:

Sub Tester()

    Debug.Print GetResult("https://maps.googleapis.com/maps/api/geocode/json?address=bojon", _
                       "results[0].geometry.location.lat")

    Debug.Print GetResult("https://maps.googleapis.com/maps/api/geocode/json?address=bojon", _
                       "results[0].geometry.location.lng")


End Sub

Function GetResult(URL As String, jsonPath As String)

    Static responseCache As Object
    Dim objHTTP As Object, json As String
    Dim sc As Object

    If responseCache Is Nothing Then
        Set responseCache = CreateObject("scripting.dictionary")
    End If

    If Not responseCache.exists(URL) Then
        Debug.Print "Fetching:" & URL
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
        objHTTP.Open "GET", "https://maps.googleapis.com/maps/api/geocode/json?address=bojon", False
        objHTTP.send ("")
        json = objHTTP.responseText
        responseCache.Add URL, json
    Else
        Debug.Print "Use cache:" & URL
        json = responseCache(URL)
    End If

    Set sc = CreateObject("scriptcontrol")
    sc.Language = "JScript"
    sc.Eval "var obj=(" & json & ")" 'evaluate the json response

    GetResult = sc.Eval("obj." & jsonPath)

End Function