-1

google api does not work to find distance between source and destination in Excel VBA

I tried changing the API, but it is not the API, it is the code.

Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "http://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
Pavel Anikhouski
  • 21,776
  • 12
  • 51
  • 66
Tanveer
  • 1
  • 1

1 Answers1

0

Since you are returning a JSON, you can more easily use a JSON parser to get the results.

I use

' VBA-JSON v2.3.0
' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON
'
' JSON Converter for VBA

And here is code that will return the driving distance between two locations:

Option Explicit
Function getDistance(sStart As String, Dest As String)
    Const API As String = "key=myAPI"
    Const sURL1 As String = "https://maps.googleapis.com/maps/api/distancematrix/json?units=imperial"
    Dim sURL() As String
    Dim sOrigin As String, sDest As String
    Dim xhrRequest As XMLHTTP60

Dim strJSON As String, JSON As Object

sOrigin = Replace("origins=" & sStart, " ", "+")
sDest = Replace("destinations=" & Dest, " ", "+")

'Many ways to create the URL to send
ReDim sURL(3)
    sURL(0) = sURL1
    sURL(1) = sOrigin
    sURL(2) = sDest
    sURL(3) = API

Set xhrRequest = New XMLHTTP60
With xhrRequest
    .Open "Get", Join(sURL, "&"), False
    .sEnd
    strJSON = .responseText
End With

Set JSON = parsejson(strJSON)


'"text" returns a string in local language
'"value" returns the distance in meters
getDistance = JSON("rows")(1)("elements")(1)("distance")("text")

End Function

There are other options, and you can read through the API documentation which is presently at the Google Distance-Matrix Developers Guide

If you expand the JSON object in the watch window, you can figure out how it is constructed to create the string to return the desired value.

Ron Rosenfeld
  • 53,870
  • 7
  • 28
  • 60
  • Thanks a lot for your reply. I copied this code and provided my Key, when I try to use it, I get the following error: "Compiler Error: User-defined type not defined" and it points to "Dim xhrRequest as XMLHTTP60" – Tanveer Oct 17 '19 at 10:55
  • @Tanveer Either set a reference to `Microsoft XML, V6.0` or convert to late-binding, as you show in your own code. – Ron Rosenfeld Oct 17 '19 at 11:42
  • Hi Ron, how to make a reference to Microsoft XML, V6.0, sorry I am not very good in it. what changes do I need to do in your code or mine code to get it working. Really appreciate your help. – Tanveer Oct 17 '19 at 11:59
  • @Tanveer To set a reference, navigate to `Tools/References` in the VBA Editor, scroll to the reference and set a check mark. I also suggest you go through your code and mine (if you decide to use it) so you understand what each step does in order to more easily maintain it in the future. Also, you can read about early vs late binding by doing an internet search, and checking the results that apply to VBA. – Ron Rosenfeld Oct 18 '19 at 01:08