I have a potential client which reimburses employ travel based on the distance between their office and homes they visit as part of their job. They have found that many of the distances included on expense accounts do not reflect the shortest distance between start and end points, and they want a way to use the distances calculated by Google Maps to standardize these mileage values.
There are many websites which provide direction, distance, and time estimates to get from point A to point B while driving. Google Maps is just one these services, many of which provide APIs that allow developers and organizations to tap into these features in their own applications.
Google recently modified its policy for using Google Maps and is now charging on a "pay-as-you-go" basis. On their web site, they indicate that they provide $200 in free usage credits per month, and that "for most of our users, the $200 monthly credit is enough to support their needs." With this knowledge in hand, I gave them my credit card info, created a new account, and got a license key (which is used in the XML request).
But when I started looking for code example, I found very few VBA examples. I did find one example of how to use the directions feature so with that code in hand, I created a simple form in a new project file to test this new feature.
I then added a reference in the project to the MS XML, v6.0 library and headed off to the races.
The code behind the 'Distance' button simply calls the function (shown below) which, although it does not include any error handlers, provides all of the details you need to get your application running.
Public Function GoogleDistance(FromAddress As String, ToAddress As String) As String
Dim strKey As String
Dim sXMLURL As String
Dim objXMLHTTP As MSXML2.ServerXMLHTTP
On Error GoTo ProcError
strKey = "your license key goes here"
sXMLURL = "https://maps.googleapis.com/maps/api/distancematrix/xml?" _
& "units=imperial&" _
& "origins=" & Replace(FromAddress, " ", "") & "&" _
& "destinations=" & Replace(ToAddress, " ", "") & "&" _
& "key=" & strKey
'Debug.Print sXMLURL
Set objXMLHTTP = New MSXML2.ServerXMLHTTP
With objXMLHTTP
.Open "Get", sXMLURL, False
.setRequestHeader "content-Type", "application/x-www-form-URLEncoded"
.send
End With
'Debug.Print objXMLHTTP.responseText
Dim domResponse As DOMDocument60
Set domResponse = New DOMDocument60
domResponse.loadXML objXMLHTTP.responseText
Dim ixnStatus As Variant
Set ixnStatus = domResponse.selectSingleNode("//status")
If ixnStatus.Text = "OK" Then
Dim ixnDistance, ixnDuration
Set ixnDistance = domResponse.selectSingleNode("/DistanceMatrixResponse/row/element/distance/text")
Set ixnDuration = domResponse.selectSingleNode("/DistanceMatrixResponse/row/element/duration/text")
End If
Forms("form1").txt_Distance = ixnDistance.Text
Forms("form1").txt_duration = ixnDuration.Text
ProcExit:
Exit Function
ProcError:
Debug.Print Err.Number, Err.Description
MsgBox Err.Number & vbCrLf & Err.Description
Resume ProcExit
Resume
End Function
I've included a couple of debug.print statements in the code to allow you to see the actual values which are passed to the request and received back as the response. If I were going to implement this within an application, I would obviously add some error handling code which would provide meaningful error messages back to the user.
Take a look at the attached .accde file and see how simple it is to include this feature in your application.
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)