Solved: Google Maps API - Distance Matrix on Microsoft Exc... - Page 2

rasec_lc · 08-18-2023 02:01 PM

I've had this working on several spreadsheets for a long time, but yesterday the functions using Google's Distance Matrix API stop working.

I tested it on another network, different computers, created a new Key, a new project on Google Cloud and it still doesn't work.

Has anyone experienced this problem, could you give me an idea how to solve it?

Thank you very much..

*the key, I removed it from the code.

---------------------------

Calculate Google Maps distance between two addresses

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=0000000000000000000000"

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

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=0000000000000000000000"

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

Public Function MultiGetDistance(ParamArray args() As Variant) As Double

MultiGetDistance = 0

Dim startLoc As String, endLoc As String, i As Long

For i = LBound(args) To UBound(args) - 1

startLoc = args(i): endLoc = args(i + 1)

MultiGetDistance = MultiGetDistance + GetDistance(startLoc, endLoc)

Next i

End Function

Public Function MultiGetDuration(ParamArray args() As Variant) As Double

MultiGetDuration = 0

Dim startLoc As String, endLoc As String, i As Long

For i = LBound(args) To UBound(args) - 1

startLoc = args(i): endLoc = args(i + 1)

MultiGetDuration = MultiGetDuration + GetDuration(startLoc, endLoc)

Next i

End Function

mvoelkerASC

I think I figured it out with one line of code. It appears that the JSON response was slightly changed by the google API. It was either character spacing or carriage return I didn't investigate further. See my below working code.

'Source code taken from https://analystcave.com/excel-calculate-distances-between-addresses/
' 8/19/23 Google JSON response format must have changed.  I had to modify my InStr() method to parse and find the result.
' https://www.googlecloudcommunity.com/gc/Developer-Tools/Google-Maps-API-Distance-Matrix-on-Microsoft-Excel-VB-Module/m-p/624366#M1309

'Calculate Google Maps distance between two addresses
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=en&sensor=false&key=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    
    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 ("")
    testvar = objHttp.responseText
            'If InStr(objHttp.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl  ---- This is now broke
    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)
    GetDistance = Round(GetDistance / 1609.34, 1)
    Range("GoogleMileageOneWay").Value = GetDistance

    Exit Function
ErrorHandl:
    GetDistance = -1
End Function

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=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    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   ---- This is now broke
    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) / 3600
    Range("GoogleTravelTimeOneWay").Value = GetDuration
    Exit Function
ErrorHandl:
    GetDuration = -1
End Function

View solution in original post

Google Maps API - Distance Matrix on Microsoft Excel VB Module