Calculating travel time between two locations

You need a way to automatically calculate the time to get from one location to another location. You might use this for giving your drivers directions to your clients. Or expand to be an efficient route because you are going to check all the distances between multiple points and go to the close one next, then the next most closest one.

So create a table with 2 columns.  StartLocation, DestinationLocation.  Then create a query based on this table and bring down both columns.  Then create a third column like this: TravelTime:getGoogleTravelTime(StartLocation, DestinationLocation)

Create a module and paste in the following code.  Note that you should not need to set any library references.

That’s it!

Option Compare Database

 

Const strUnits = “imperial” ‘ imperial/metric (miles/km)

‘You need a way to automatically calculate the time to get from one location to another location.  You ‘might use this for giving your drivers directions to your clients.  Or expand to be an efficient route ‘because you are going to check all the distances between multiple points and go to the close one next, ‘then the next most closest one.

 

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””

‘ Author of this module: desmond oshiwambo

‘ original reference found here: https://desmondoshiwambo.wordpress.com/2013/06/20/how-to-get-google-travel-time-and-distance-in-vba/

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

 

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

‘ Example of calling function:  ?getGoogleTravelTime(“rolling creek place, glen allen,va 23059″,”bar harbor maine”)

’12:51

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

 

 

 

Function CleanHTML(ByVal strHTML)

 

    ‘Helper function to clean HTML instructions

    Dim strInstrArr1() As String

    Dim strInstrArr2() As String

    Dim s As Integer

    

        strInstrArr1 = Split(strHTML, “<“)

        For s = LBound(strInstrArr1) To UBound(strInstrArr1)

        strInstrArr2 = Split(strInstrArr1(s), “>”)

       If UBound(strInstrArr2) > 0 Then

            strInstrArr1(s) = strInstrArr2(1)

       Else

            strInstrArr1(s) = strInstrArr2(0)

       End If

    Next

     

    CleanHTML = Join(strInstrArr1)

   

End Function

 

 

Public Function formatGoogleTime(ByVal lngSeconds As Double)

‘Helper function. Google returns the time in seconds, so this converts it into time format hh:mm

 

Dim lngMinutes As Long

Dim lngHours As Long

 

lngMinutes = Fix(lngSeconds / 60)

lngHours = Fix(lngMinutes / 60)

lngMinutes = lngMinutes – (lngHours * 60)

 

formatGoogleTime = Format(lngHours, “00”) & “:” & Format(lngMinutes, “00”)

End Function

 

 

Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = “”) As Boolean

On Error GoTo errorHandler

‘ Helper function to request and process XML generated by Google Maps.

 

Dim strURL As String

Dim objXMLHttp As Object

Dim objDOMDocument As Object

Dim nodeRoute As Object

Dim lngDistance As Long

 

Set objXMLHttp = CreateObject(“MSXML2.XMLHTTP”)

Set objDOMDocument = CreateObject(“MSXML2.DOMDocument.6.0”)

 

strStartLocation = Replace(strStartLocation, ” “, “+”)

strEndLocation = Replace(strEndLocation, ” “, “+”)

 

strURL = “http://maps.googleapis.com/maps/api/directions/xml” & _

            “?origin=” & strStartLocation & _

            “&destination=” & strEndLocation & _

            “&sensor=false” & _

            “&units=” & strUnits   ‘Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request

 

‘Send XML request

With objXMLHttp

    .Open “GET”, strURL, False

    .setRequestHeader “Content-Type”, “application/x-www-form-URLEncoded”

    .send

    objDOMDocument.loadXML .responseText

End With

 

With objDOMDocument

    If .selectSingleNode(“//status”).Text = “OK” Then

        ‘Get Distance

        lngDistance = .selectSingleNode(“/DirectionsResponse/route/leg/distance/value”).Text ‘ Retrieves distance in meters

        Select Case strUnits

            Case “imperial”: strDistance = Round(lngDistance * 0.00062137, 1)  ‘Convert meters to miles

            Case “metric”: strDistance = Round(lngDistance / 1000, 1) ‘Convert meters to miles

        End Select

        

        ‘Get Travel Time

        strTravelTime = .selectSingleNode(“/DirectionsResponse/route/leg/duration/value”).Text  ‘returns in seconds from google

        strTravelTime = formatGoogleTime(strTravelTime) ‘converts seconds to hh:mm

        

        ‘Get Directions

        For Each nodeRoute In .selectSingleNode(“//route/leg”).childNodes

            If nodeRoute.baseName = “step” Then

                strInstructions = strInstructions & nodeRoute.selectSingleNode(“html_instructions”).Text & ” – ” & nodeRoute.selectSingleNode(“distance/text”).Text & vbCrLf

            End If

        Next

        

        strInstructions = CleanHTML(strInstructions) ‘Removes MetaTag information from HTML result to convert to plain text.

        

    Else

        strError = .selectSingleNode(“//status”).Text

        GoTo errorHandler

    End If

End With

 

gglDirectionsResponse = True

GoTo CleanExit

 

errorHandler:

    If strError = “” Then strError = Err.Description

    strDistance = -1

    strTravelTime = “00:00”

    strInstructions = “”

    gglDirectionsResponse = False

 

CleanExit:

    Set objDOMDocument = Nothing

    Set objXMLHttp = Nothing

 

End Function

 

 

Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String

‘Returns the journey time between strFrom and strTo

 

Dim strTravelTime As String

Dim strDistance As String

Dim strInstructions As String

Dim strError As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleTravelTime = strTravelTime

Else

    getGoogleTravelTime = strError

End If

 

End Function

 

 

Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String

‘Returns the distance between strFrom and strTo

‘where strFrom/To are address search terms recognisable by Google

‘i.e. Postcode, address etc.

 

Dim strTravelTime As String

Dim strDistance As String

Dim strError As String

Dim strInstructions As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleDistance = strDistance

Else

    getGoogleDistance = strError

End If

 

End Function

 

 

Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String

‘Returns the directions between strFrom and strTo

‘where strFrom/To are address search terms recognisable by Google

‘i.e. Postcode, address etc.

 

Dim strTravelTime As String

Dim strDistance As String

Dim strError As String

Dim strInstructions As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleDirections = strInstructions

Else

    getGoogleDirections = strError

End If

 

End Function

 

 

 

This entry was posted in Uncategorized and tagged , , . Bookmark the permalink.

Comments are closed.