GoogleMaps API Macro/VBA Not Returning DriveTime & DriveDistance Anymore

123 Views Asked by At

I had the following macros that created a formula in Excel where I could link two addresses and get either the drive distance or drive time.

e.g., =GetDistance(A1,B1)*0.000621371 <- b/c it came in Meters so converted to miles
e.g., =GetDuration(A1,B1)/3600 <- b/c it came in seconds so converted to hours

Here are the two macros. Does anyone know why they're not working anymore. My guess is that google changed the path slightly to access them but I don't know enough about VBA or GoogleMaps API to fix it so pardon my ignorance

Get Google Maps distance (in meters)

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

Get Google Maps duration (in seconds)

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

Did some research in Google Maps Platform documentation but can't seem to find the path.

1

There are 1 best solutions below

0
Throyd On

I fixed it, see the code below. The real issue was the ErrorHandl call.

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

Remember to update your API Key :)