Excel VBA 提取值 JSON URL答案

【问题标题】：Excel VBA extract values JSON URLExcel VBA 提取值 JSON URL
【发布时间】：2015-10-03 03:03:51
【问题描述】：

在 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, Italia"

=LATITUDE(A1) 结果 = "45.33887499999999"

=LONGITUDE(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"

=LATITUDE(A1) 结果 = "33.9936153"

=LONGITUDE(A1) 结果 = "-118.4799099"

谁能帮帮我？

【问题讨论】：

为什么是 JSON？为什么不是 XML maps.googleapis.com/maps/api/geocode/xml?address=bojon？使用 VBA 更容易解析。
您可能只想为 VBA 获取完整的 json 解析器。我知道有一对，“无耻的插件”是我自己写的，如果你有兴趣，我很乐意分享。

标签： json excel vba google-maps url

【解决方案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

【讨论】：

【解决方案2】：

试试这个模式："""lat""(\s)*:(\s)*(\d)+(.(\d)+)?"

分解一下，

""lat"" 匹配字符串
(\s)* 匹配可能在标记之间
：是字面意思
(\s)* 再次匹配空格
(\d)+ 匹配一些数字
(.(\d)+)?可选匹配小数点后跟一串数字（至少一个）

在这个例子中，我把另外两个留给你作为练习，但如果你有问题，请告诉我！

【讨论】：