Origins Destinations Excel VBA API (Google Maps) - excel

Question

I am trying to find the distance and travel time between multiple origins and destinations. For some reason, my code does not work at all. There are no errors, i just have nothing as output. See the attached Image for Excel worksheet.
Sub Origins_Destinations()
Dim a, b, i, Str As String
Dim lineS As Variant
On Error Resume Next
'Application.ScreenUpdating = False
With CreateObject("WinHttp.WinHttpRequest")
Dim iRow As Long: iRow = ThisWorkbook.Worksheets(1).Range("g65000").End(xlUp).Row
For j = 4 To iRow
b = ThisWorkbook.Worksheets(1).Range("b4" & j)
a = ThisWorkbook.Worksheets(1).Range("a4" & j)
.Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/json?units=imperial&origins=" & a & " &destinations= " & b & " &key=MY_KEY", False
.Send
lineS = Split(.ResponseText, vbLf)
For k = 25 To UBound(lineS)
If Trim(lineS(k)) = """distance"" : {" Then
Exit For
End If
Next k
ThisWorkbook.Worksheets(1).Range("c" & j) = lineS(k + 1)
ThisWorkbook.Worksheets(1).Range("d" & j) = lineS(k + 5)
Application.Wait (Now + TimeValue("0:00:01"))
Next j
End With
Application.ScreenUpdating = True
End Sub
enter image description here
Any suggestions ?????

Answer 1

As far as I understand, the code below is what you're looking for to get you started. Enter your Google Maps API Key in the Constant at the top, and then run sub TestRun.
It will replace disallowed characters in the address you provided, then loads the JSON results from Google Matrix into a string, and then, since we're only looking for 1 or 2 values, it will use a messy cheater-method to location the values, that I can't guarantee will always work:
It finds the first occurrence of the word "distance", and then the first occurrence of the word "value" after that, move 3 more characters to the right, and then take whatever is between there and the next " " blank space, and converts it to a value, hopefully the distance in meters.
Then it repeats (from beginning of file) to find "duration" in seconds, the same method. Note that the distance and duration are being returned to variables "byref".
As I said, it's very convoluted, but you get what you pay for. (Normally I wouldn't share code this "yucky", but you're in my neighborhood, so, Go Canada!)
Option Explicit
'3333 University Way,Kelowna,BC,V1V 1V7
'1555 Banks Rd, Kelowna, BC, V1X 7Y8
'1938 Pandosy Street, Kelowna, BC, V1Y 1R7
'2280 Baron Rd, Kelowna, BC, V1X 7W3
Const key = "YOUR-API-KEY-HERE"
Sub testRun()
Dim orig As String, dest As String, distance_Meters As Long, duration_Sec As Long
orig = EncodeEscapeString("3333 University Way,Kelowna,BC,V1V 1V7")
dest = EncodeEscapeString("1555 Banks Rd, Kelowna, BC, V1X 7Y8")
Call getGoogleDistanceMatrix(orig, dest, distance_Meters, duration_Sec)
Debug.Print distance_Meters & "m"
Debug.Print duration_Sec & "sec"
End Sub
Sub getGoogleDistanceMatrix(ByVal orig As String, ByVal dest As String, ByRef distance_Meters As Long, ByRef duration_Sec As Long)
Const distanceTag1 = """distance"""
Const distanceTag2 = """value"""
Const durationTag1 = """duration"""
Const durationTag2 = """value"""
Dim jSON As String, pStart As Long, pEnd As Long
jSON = Get_URL_text("https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" & orig & "&destinations=" & dest & "&key=" & key)
pStart = InStr(jSON, distanceTag1) + Len(distanceTag1)
pStart = InStr(pStart, jSON, distanceTag2) + Len(distanceTag2) + 3
pEnd = InStr(pStart, jSON, " ")
distance_Meters = Val(Trim(Mid(jSON, pStart, pEnd - pStart)))
pStart = InStr(jSON, durationTag1) + Len(durationTag1)
pStart = InStr(pStart, jSON, durationTag2) + Len(durationTag2) + 3
pEnd = InStr(pStart, jSON, " ")
duration_Sec = Val(Trim(Mid(jSON, pStart, pEnd - pStart)))
End Sub
Function Get_URL_text(url As String) As String
Dim XMLHTTP As Object
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.send
Get_URL_text = XMLHTTP.responseText
Set XMLHTTP = Nothing
End Function
Function EncodeEscapeString(str_In As String) As String
Dim s As String
s = str_In
s = Replace(s, "%", "%25")
s = Replace(s, " ", "%20")
s = Replace(s, Chr(34), "%22")
s = Replace(s, "<", "%3C")
s = Replace(s, ">", "%3E")
s = Replace(s, "#", "%23")
s = Replace(s, "|", "%7C")
EncodeEscapeString = s
End Function
This same "cheater method" can be used to to scrape bits of data from any URL (JSON, HTML, XML, CSV, etc) that has a consistent text output.
You may need to add a Tools -> Reference to support XMLHTTP.
Good luck with that! (and don't forget to "accept" this answer if it's at all useful, I already put more time into this than I intended!)