Automating external data import with Excel (2)

Posted on by

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.

  1. A PHP Script; that builds the full URL to the Google DistanceMatrix API and returns only the distance.
  2. 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']."&amp;destinations=".$_REQUEST['d']."&amp;language=nl-NL&amp;sensor=false&amp;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[0]->element[0]->distance[0]->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.
VBA-getKM-sample