GoogleMaps API 宏/VBA 不再返回行驶时间和行驶距离

Question

我使用以下宏在 Excel 中创建了一个公式，我可以在其中链接两个地址并获取行驶距离或行驶时间。

例如，

=GetDistance(A1,B1)*0.000621371

<- b/c it came in Meters so converted to miles
例如，

=GetDuration(A1,B1)/3600

<- b/c it came in seconds so converted to hours

这是两个宏。有谁知道为什么他们不再工作了。我的猜测是，谷歌稍微改变了访问它们的路径，但我对 VBA 或 GoogleMaps API 的了解不够，无法修复它，所以请原谅我的无知

获取 Google 地图距离（以米为单位）

Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=pl&sensor=false&key=*MyKey*"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    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, """distance"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDistance = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    GetDistance = -1
End Function

获取 Google 地图持续时间（以秒为单位）

Public Function GetDuration(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=en&sensor=false&key= *MyKey*"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    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, """duration"" : {") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "duration(?:.|\n)*?""value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDuration = CDbl(tmpVal)
    Exit Function
ErrorHandl:
    GetDuration = -1
End Function

在 Google Maps Platform 文档中进行了一些研究，但似乎找不到路径。

Answer 1

我修复了它，请参阅下面的代码。真正的问题是 ErrorHandl 调用。

Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=es&avoidTolls=True&key=*MyKey*&v=3.50"

Set ObjHTTP = CreateObject("MSXML2.ServerXMLHTTP")

Url = firstVal & start & secondVal & dest & lastVal

ObjHTTP.Open "GET", Url, False
ObjHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
ObjHTTP.Send ("")

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
Set matches = regex.Execute(ObjHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)

End Function

记得更新您的 API 密钥:)