As i wrote earlier on my blog (and twitter) i would get back to this subject.
The task is quite simple. You have a Microsoft Excel sheet with a list of visits you did in a year. You did register each customer, and it’s zipcode, and complete address. Now your boss (or his secretary) asks you to deliver a sheet with kilometers travelled for your visits.
One can take a whole day (or more) to look them up with Google Maps, or you can use the data that you already have and automate this process with the Google Api’s.For this task i took the average distance between two zipcodes. (In my country the zipcodes are assigned to a particular part of a street or road, so that is specific enough).
For my task i needed atleast two scripts, as my VBA knowledge isn’t sufficient enough to parse the XML returned by Google.
- A PHP Script; that builds the full URL to the Google DistanceMatrix API and returns only the distance.
- A Visual Basic for Applications Script; that uses the data in Microsoft Excel and retrieve the data from my PHP script.
The PHP script is shown below and quite simple.
<?php $url = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=".$_REQUEST['s']."&destinations=".$_REQUEST['d']."&language=nl-NL&sensor=false&mode=".$_REQUEST['mode']; $ch = curl_init ($url); curl_setopt ($ch, CURLOPT_URL, $url); curl_setopt($ch, CURLOPT_RETURNTRANSFER, 1); curl_setopt($ch, CURLOPT_SSL_VERIFYPEER, FALSE); curl_setopt($ch, CURLOPT_NOPROGRESS, 0); $data = curl_exec($ch); curl_close($ch); $xml = simplexml_load_string($data); echo number_format( $xml->row->element->distance->value/1000 , 2, ',', '');
First we build the URL based on three parameters retrieved from the called URL.
Next we create a curl object and set some options.
After executing the actual curl-call we store the data in a temporary variable.
We load an simplexml object based on the data we got from Google.
At last we return the distance value. We already do some number conversion as the default float uses a dot as decimal separator, and my Excel does expect the comma.
Now that we have the ability to retrieve only the distance between two zipcodes we can loop through the Excel list.
First the function that gets the details for me. (The script called only returns the distance!)
Function GetKm(strSource As String, strDestination As String, strMode As String) On Error GoTo ErrorHandler Dim strUrl As String strUrl = "http://remoteserver.example.com/google_maps_distance_api.php?s=" + strSource + "&d=" + strDestination + "&mode=" + strMode ' MsgBox strUrl, vbOKOnly, "Url to fetch" Dim strError As String strError = "" Dim oXMLHTTP 'As MSXML2.XMLHTTP On Error Resume Next Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") If Err.Number <> 0 Then Set oXMLHTTP = CreateObject("MSXML.XMLHTTPRequest") MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object" End If On Error GoTo 0 If oXMLHTTP Is Nothing Then MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object" Exit Function End If On Error GoTo ErrorHandler Dim strResponse As String strResponse = "" With oXMLHTTP .Open "GET", strUrl, False .send "" If .Status <> 200 Then strError = .statusText GoTo CleanUpAndExit Else If .getResponseHeader("Content-type") <> "text/html" Then strError = "Not an HTML file" GoTo CleanUpAndExit Else strResponse = .responseText End If End If End With CleanUpAndExit: On Error Resume Next ' Avoid recursive call to error handler ' Clean up code goes here Set oXMLHTTP = Nothing ' Report any error If Len(strError) > 0 Then MsgBox strError, vbOKOnly + vbCritical, "Error" Else GetKm = strResponse End If Exit Function ErrorHandler: strError = Err.Description Resume CleanUpAndExit End Function
And the last trick, walk through the list of entries and process them.
Sub FetchLoop() ' Select the zipcode of atleast the second row to loop succesfull! Dim Check, PostcodeSource As String, PostcodeDestination As String, Driving, Walking, myObject, pand1, pand2 Check = True Dim Counter, Maxcount As Integer Counter = 0 Maxcount = InputBox(Prompt:="What is the maximum number of rows to process?", Title:="Maximum rows", Default:="25") Driving = 0 Walking = 0 Do Counter = Counter + 1 PostcodeSource = ActiveCell.Offset(-1, 0).Value ' Get the content of the cell one above to the current one. PostcodeDestination = ActiveCell.Value ' Get the content of the current active cell. If Not (PostcodeSource <> "") Or Not (PostcodeDestination <> "") Then ' If Zipcodes are empty, set Check to false, Check = False End If If Check Then ' If Check = True, prepare for the check If (PostcodeSource <> PostcodeDestination) Then ' If Source and Destination are not the same, get distances. Driving = GetKm(PostcodeSource, PostcodeDestination, "driving") ' Get distance for driving Walking = GetKm(PostcodeSource, PostcodeDestination, "walking") ' Get distance for walking Else ' If Source and Destination zipcode are the same, set distances to 0 Driving = 0 Walking = 0 End If ActiveCell.Offset(0, 2).Value = CDec(Driving) ' Write distance for driving to the current row, two cells to the right, converting it to a decimal number ActiveCell.Offset(0, 3).Value = CDec(Walking) ' Write distance for driving to the current row, three cells to the right, converting it to a decimal number If (PostcodeSource <> PostcodeDestination) Then ' If Zipcodes differ, wait 4.5 seconds, as we have limitations with Google. Sleep 4500 ' Sleep for 4.5 seconds End If End If If (Maxcount) Then ' If Maxcount is set, check for our progress If (Counter >= Maxcount) Then ' If our Counter equals or is higher then the maximum rows to process.. Check = False ' Set Check to false End If End If Sleep 500 ' Sleep for 0.5 seconds ActiveCell.Offset(1, 0).Select ' Select the cell one below the current one! Loop Until Check = False ' If Check == False, stop the loop! End Sub
Last but not least, include the declaration for the sleep function, otherwise you could overload Google with your requests
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
The Excel table could be quite simple make at least 6 columns,
Date, Time, Zipcode, Building No., Distance Car, Distance Walking
If you are interested in the whole package you can download the ZIP-file from my site.