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.