Heres a little example of some VBA functions I put together to get geocodes into excel using the google maps API.
It’s not the best geocoder in the world, but it does ok in the test I’ve done so far, although it does just come up with blanks for some locations. To use it you will need a Google maps API key which you need to store in a text file on the same path as the workbook, details are on the first sheet of the workbook.
As for the code itself I had to automate IE rather than use an API or the HTTP or XMLHTTP libraries, as my corporate firewall would not allow access using these. The function only asks for 1 string, so you have to add spaces yourself, this might be done better, but it suited my needs (that is to say, I didn’t bother writing in optional arguments etc.)
It’s worth while looking at the code as I have done a few things that might not be considered “best practice”, mainly not closing the IE application when the function has run – this is to speed up the function – there is a public function that you can use to close it from a worksheet if you wish (see code as it’s not explained in the “documentation”)
Theres probably some other stuff that I should mention, but I did this a week or so ago and have not been able to post it as my internet connection was down, so I have forgotten that!
Feel free to post any questions and I’ll feel free not to answer them!!!!
Enjoy
Ross
Hey Cool, Ross!
We’ll need to teach Google about Canada though… I’m on the left cost, on the big island, right about even with the US border. :)
Thanks Ken,
Your location is mostly down to me putting it in wrong I think!!!! I didn’t know you were an island dweller though!
Really nice Ross. Any guidance on how I could push this further to report driving distances between two locations? I’ve got the basic “http://maps.google.com/maps?saddr={startlocation}&daddr={endlocation}” , but would really value how I could capture the results back from Google.
I was wondering the same thing concerning driving distances. Anyone got this to work – you yet JS?
Thanks!
Hi Chaps,
I will take a look at this when i get a little bit of free time, mean while if you are really stuck you can try using great circles to get the stright line distance see : http://mathworld.wolfram.com/GreatCircle.html
then sum the result by about 1.2 – 1.4 to get the road distance, this is gives ok results depending on your needs.
I did another loop on this and have a way of getting the distance. Basically within the (18 page) output from appIE.Document.Body.innerHTML are journey distance and journey time. So I have simply added a text search of the output and then sliced out the data required.
Very ugly, but seems reasonably reliable: I hope there is a more elegant way. One comment – for Europe at least – is that Google Earth has much poorer journey offer than Microsoft. For instance Google cannot do anything in Russia, Balkans or China (I know this is not Europe) where Microsoft Maps Live does.
Listing
Sub Router()
‘function(sStart As String, sEnd As String) as string
‘//Dont want to open and close all day long – make once use many
Dim sLocation As String
Dim sStart As String
Dim sEnd As String
Dim Answer As String
sStart = “Warsawa+Poland”
sEnd = “Northampton+England”
If appIE Is Nothing Then
CreateIEApp
‘// if = nothing now then there was an error!
If appIE Is Nothing Then
Answer = “Sorry could not launch IE”
Exit Sub
Else
‘//do nothing
End If
Else
‘//do nothing!
End If
If GMAPI_Key = “” Then
‘//Get Google API key
GMAPI_Key = GetGMAPIKey
End If
‘// check we got API key OK
If GMAPI_Key = CST_NOGMAPI_KEY Then
Answer = CST_NOGMAPI_KEY
Exit Sub
Else
‘//do nothing
End If
‘//Build URL for Query
sLocation = “http://maps.google.com/maps?saddr={” & sStart & “}&daddr={” & sEnd & “}”
sLocation = sLocation & “&output=csv&key=%20″
sLocation = sLocation & GMAPI_Key
‘Debug.Print sLocation
‘// go to the google web service and get the raw CSV data!
appIE.Navigate sLocation
Do While appIE.Busy
Application.StatusBar = “Contacting Google Maps API…”
Loop
Application.StatusBar = False
On Error GoTo depart
‘//we have to do a bit of prasing, luckily the formate is constant
Dim ansMiles As Single
Dim ansUom As String
Dim ansHrs As Integer
Dim ansMin As Integer
Answer = appIE.Document.Body.innerHTML
Answer = Mid(Answer, InStr(Answer, “class=pw>”) + 9, 50)
If Len(Answer)
sorry missed the key bit from listing….
Answer = appIE.Document.Body.innerHTML
Answer = Mid(Answer, InStr(Answer, “class=pw>”) + 9, 50)
If Len(Answer)
How strange, Less than symbol in listing kills the rest of the listing…
If Len(Answer) [less than] then
Debug.Print “no journey result”
Else
Debug.Print Answer
ansMiles = CSng(Left(Answer, InStr(Answer, “&”) – 1))
ansUom = Mid(Answer, InStr(1, Answer, “;”) + 1, 2)
ansHrs = CInt(Mid(Answer, InStr(1, Answer, “about “) + 6, 2))
ansMin = CInt(Mid(Answer, InStr(1, Answer, “hours “) + 6, 2))
MsgBox sStart & ” to ” & sEnd & vbCrLf _
& ansMiles & ” ” & ansUom & ” : ” & ansHrs + (ansMin * (100 / 60) * 0.01) & ” Hrs”
End If
Exit Sub
depart:
MsgBox “Journey did not calculate”
‘Answer = CStr(CloseIEApp)
End Sub
JS – thanks for the reply. I keep getting Journey Did Not Calculate though. Any ideas?
Larry.Weideman (at) gmail.com
Larry
Have you followed all of Ross’s original instructions about getting a Google API key?
I have used Ross’s worksheet and added Router as a new procedure. If you are getting a good result on his original geo-coding procedure, I cannot see why it would not calc.
Maybe comment out the ‘On Error GoTo depart’ line and see where the error is coming up?
JS
Yes I did and yes his Geocode sheet works great.
I also added this as a new procedure (and tried it as a seperate worksheet) and it fails at ansMiles = CSng(Left(Answer, InStr(Answer, “&”) – 1)) that line every time. I am not sure why – I’m newer to coding.
Thanks for the reply – larry.weideman (at) gmail.com
OK thats should be straightforward to fix. the Answer variable is just a string extracted from the google return data. The code assumes in there is a “&” and then extracts a sub-string which should be some numbers showing miles (I said it was crude!). If you put a debug.print answer in the previous line and put a break on this you can stop and check what the answer string is you are working on, maybe you can then tune the formula. My guess is that the CSng (conversion of the text to a number) is the cause of failure; the string extracted has, say, space in it. Hope that helps
JS – thanks again for the help to this newbie. I think I must have copied something wrong (thought I’ve done it a few times.) Any way to get this in a text file.
When I tried your suggestion this is what I get in the Immediate Window for the debug Answer.
d=homestate>
Oh! I guess this may be a difference in the output from Google for different geographies. Suggest you might put a “debug.print answer” after line with “Answer = Mid(Answer, InStr(Answer, “class=pw>”) + 9, 50)”. The string SHOULD (it does for me) contain data that aligns with (a) a mileage (b) a journey location. (that is the target answer, but to report it properly you will need to play with the subsequent text slicing formulas to get each element out properly. My guess is that the change in what you are finding is due to different formats between Europe output and North America.
Otherwise examine the previous (raw) output from Google.
I think there must be a more elegant solution than mine, I am hoping Ross comes up with that!
Hello everybody,
I put it in as a new function named ‘router’ in the original sheet.
Wat is the statement I have to put in a cell of my excel sheet to get the result.
ex. for goecode it is =geocode(C51&” “&D51&” “&E51&” “&F51)
thanks,
Steve
Steve
Change router to a function by changing code like this:
Sub Router() - change to Router(sStart as string, sEnd as string) as string
“˜function(sStart As String, sEnd As String) as string -delete this line
“˜//Dont want to open and close all day long – make once use many
Dim sLocation As String
Dim sStart As String – delete this line
Dim sEnd As String - delete this line
Dim Answer As String
sStart = “Warsawa+Poland” -delete this line
sEnd = “Northampton+England” -delete this line…
find this line…
MsgBox sStart & ” to ” & sEnd & vbCrLf _
& ansMiles & ” ” & ansUom & ” : ” & ansHrs + (ansMin * (100 / 60) * 0.01) & ” Hrs”
replace with
Router= sStart & ” to ” & sEnd & vbCrLf _
& ansMiles & ” ” & ansUom & ” : ” & ansHrs + (ansMin * (100 / 60) * 0.01) & ” Hrs”
so the function entry is =router(YourStartLocation, YourEndLocation) and the result is a string in the cell listing the distance etc.
Hi
thanks for the code everything works except the router function to calculate de distance. It open the google map navigation windows but dont calculate the distance between cities. I have a list of 4000 cities and i need to feed and excel sheet with the distance between them. Can you help me.
The code that Im using is
[VBA]
Option Explicit
‘// Methods In Excel
‘// http://www.bblog.methodsinexcel.co.uk
‘// Code by Ross McLean
‘// Use at own risk!
‘//
‘// This Modual contians all the code needed to geocode from google maps API
‘// It automates Internet Explore, which although not as nice as using HTTP/XMLHTTP objects
‘// it should work on most PC that have internet access – i.e not be efected by corprate fire walls
‘//
‘//
‘// The google Maps API is likely to change offten so this code may brake as a
‘// result of that. At the time of writing (Oct 2007) this code worked!
‘//
‘//
‘// :::::IMPORTANT NOTICE::::::
‘// This code is provided as is as a example of how to acumlished the task, please complie
‘// with Googles terms and contionds!(http://www.google.com/apis/maps/terms.html)
‘//
‘// Google Maps API Key:
‘// You will need to have your own google maps api Key, this is all stright forward stuff:
‘// goto: http://www.google.com/apis/maps/signup.html
‘//
‘//
‘// Applying your key:
‘// You can past you key into this code after it delcration in the or you can copy your
‘// key into a text file and store it in the same location at the workbook that will use it
‘// this allows you to control key useage by uer or by spread sheet.
‘// NB: if using the text file, it should contian nothing but the key
‘// and must be called “GM_Key.txt” with out the dobblue qoutes.
Private GMAPI_Key As String ‘//Fix here (change to Private Const) if you want wkb level Google API control
Private appIE As Object ‘Hold late bound IE object
Private Const CST_NOGMAPI_KEY As String = “Sorry, could not Load Google Maps API Key”
Function GeoCode(sLocationData As String) As String
‘//Dont want to open and close all day long – make once use many
If appIE Is Nothing Then
CreateIEApp
‘// if = nothing now then there was an error!
If appIE Is Nothing Then
GeoCode = “Sorry could not launch IE”
Exit Function
Else
‘//do nothing
End If
Else
‘//do nothing!
End If
If GMAPI_Key = “” Then
‘//Get Google API key
GMAPI_Key = GetGMAPIKey
End If
‘// check we got API key OK
If GMAPI_Key = CST_NOGMAPI_KEY Then
GeoCode = CST_NOGMAPI_KEY
Exit Function
Else
‘//do nothing
End If
‘//clearing up input data
‘sLocationData = Replace(sLocationData, “,”, ” “)
sLocationData = Replace(sLocationData, ” “, “+”)
sLocationData = Trim(sLocationData)
‘//Build URL for Query
sLocationData = “http://maps.google.com/maps/geo?q=%20_” & sLocationData
sLocationData = sLocationData & “&output=csv&key=%20″
sLocationData = sLocationData & GMAPI_Key
Debug.Print sLocationData
‘// go to the google web service and get the raw CSV data!
appIE.Navigate sLocationData
Do While appIE.Busy
Application.StatusBar = “Contacting Google Maps API…”
Loop
Application.StatusBar = False
On Error Resume Next
‘//we have to do a bit of prasing, luckily the formate is constant
GeoCode = appIE.Document.Body.innerHTML
GeoCode = Mid(GeoCode, InStr(GeoCode, “,”) + 1, InStr(GeoCode, “/”) – InStr(GeoCode, “,”) – 2)
End Function
Private Function GetGMAPIKey() As String
‘On Error GoTo errHand
If GMAPI_Key = “” Or GMAPI_Key = CST_NOGMAPI_KEY Then
‘//Load Google API Key form text file
‘// not that GMAPI_Key is public so should nly need to load file once!
Dim iChars As Integer
Dim iFile As Integer
iFile = FreeFile
Open ThisWorkbook.Path & “\GM_Key.txt” For Input As iFile
iChars = LOF(iFile)
GetGMAPIKey = Input(iChars, iFile)
Exit Function
Else
GetGMAPIKey = GMAPI_Key
End If
Exit Function
errHand:
GetGMAPIKey = CST_NOGMAPI_KEY
End Function
Private Function CreateIEApp()
‘//Create Internet Explorer application Object
On Error GoTo errHand
Set appIE = CreateObject(“InternetExplorer.Application”)
Exit Function
errHand:
appIE = Nothing
End Function
Public Function CloseIEApp() As Byte
‘// Made public to use if user likes
On Error GoTo errHand
appIE.Quit
CloseIEApp = 1
Exit Function
errHand:
CloseIEApp = 0
End Function
Sub Auto_close()
‘// I keep the appIE open for the life of the work book.
‘//If you have a auto close sub already, add this call to it!
CloseIEApp
End Sub
Public Function GeoCodeA(sScore As String) As String
sScore = Left(sScore, 1)
Select Case sScore
Case 0
GeoCodeA = “Unknown location”
Case 1
GeoCodeA = “Country level”
Case 2
GeoCodeA = “Region level”
Case 3
GeoCodeA = “Sub-region level”
Case 4
GeoCodeA = “Town/Village level”
Case 5
GeoCodeA = “Post Code level”
Case 6
GeoCodeA = “Street level”
Case 7
GeoCodeA = “Intersection level”
Case 8
GeoCodeA = “Address level”
Case Else
GeoCodeA = “Not Found”
End Select
End Function
Public Function Router(sStart As String, sEnd As String) As String
‘//Dont want to open and close all day long – make once use many
Dim sLocation As String
Dim Answer As String
If appIE Is Nothing Then
CreateIEApp
‘// if = nothing now then there was an error!
If appIE Is Nothing Then
Answer = “Sorry could not launch IE”
Exit Function
Else
‘//do nothing
End If
Else
‘//do nothing!
End If
If GMAPI_Key = “” Then
‘//Get Google API key
GMAPI_Key = GetGMAPIKey
End If
‘// check we got API key OK
If GMAPI_Key = CST_NOGMAPI_KEY Then
Answer = CST_NOGMAPI_KEY
Exit Function
Else
‘//do nothing
End If
‘//Build URL for Query
sLocation = “http://maps.google.com/maps?saddr={” & sStart & “}&daddr={” & sEnd & “}”
sLocation = sLocation & “&output=csv&key=%20?”
sLocation = sLocation & GMAPI_Key
‘Debug.Print sLocation
‘// go to the google web service and get the raw CSV data!
appIE.Navigate sLocation
Do While appIE.Busy
Application.StatusBar = “Contacting Google Maps API”¦”"”
Loop
Application.StatusBar = False
On Error GoTo depart
‘//we have to do a bit of prasing, luckily the formate is constant
Dim ansMiles As Single
Dim ansUom As String
Dim ansHrs As Integer
Dim ansMin As Integer
Answer = appIE.Document.Body.innerHTML
Answer = Mid(Answer, InStr(Answer, “class = pw > “) + 9, 50)
If Len(Answer)
Just wanted to point out that in the google TOS they clearly state that the use of geocoding for any other reason than to display on google maps is forbidden.
Great code and it all works! Google do permit the use of VBA type applications but the app has to be freely downloadable. Otherwise the premier licence starts at $10,000 – which is a bit steep when my whole app cost less than that to build and is used by 2 people who want the distance between two points maybe 20 times a day. Is there a free or cheap (like $50pa!) geocoding solution out there in-house apps to use?
ok so try this:
build a small MS Access (or Excel) application that receives 2 addresses in a command line parameter and a location to save the result.
provide this tiny App on your website for free download
from the commercial app call the tiny app which will do the API calls and save the results back into the main database
does that meet the free API licence terms? – I have put this to Google so will let you know the answer when it comes.
more to this – if you only want to display Google Map pages and then parse to get info out of them, the API Key is not required at all. Mapki has a list of the parameters that can be used:
http://mapki.com/wiki/Google_Map_Parameters
[...] http://www.blog.methodsinexcel.co.uk/2007/11/12/geocoding-in-excel-using-google-maps-api/ [...]
This code was really helpful, thanks. Although this approach still works, I ended up tweaking it a bit.
First, the current Google Apps API recommends a different URL. When you use that you don’t need an API key, and I worry the previous URL might be deprecated. Second, I found it more convenient to use the XMLHTTPREquest object. The code is below, in case it can help anyone else. (I modified the XML code from another site, don’t recall the source…)
I call the You’d call the function with:
=Geocode(URLEncode(“Address, City, State”, True))
Public Function GeoCode(sLocationData As String) As String
Dim oHttp As Object
Dim sURL As String, sHTML As String
Dim status As String, lat As String, lon As String
Dim lTopicstart As Long, lTopicend As Long
sURL = “http://maps.googleapis.com/maps/api/geocode/xml?address=” & sLocationData & “&sensor=false”
‘ Create an XMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject(“MSXML2.XMLHTTP”)
If Err.Number 0 Then
Set oHttp = CreateObject(“MSXML.XMLHTTPRequest”)
MsgBox “Error 0 has occured while creating a MSXML.XMLHTTPRequest object”
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox “For some reason I wasn’t able to make a MSXML2.XMLHTTP object”
Exit Function
End If
‘Open the URL in browser object
oHttp.Open “GET”, sURL, False
oHttp.Send
sHTML = oHttp.ResponseText
Set oHttp = Nothing
‘ Status
lTopicstart = InStr(1, sHTML, “”, vbTextCompare)
lTopicend = InStr(1, sHTML, “”, vbTextCompare)
status = Mid(sHTML, lTopicstart + 8, lTopicend – lTopicstart – 8)
‘ Lat
lTopicstart = InStr(1, sHTML, “”, vbTextCompare)
lTopicend = InStr(1, sHTML, “”, vbTextCompare)
lat = Mid(sHTML, lTopicstart + 5, lTopicend – lTopicstart – 5)
‘ Lon
lTopicstart = InStr(1, sHTML, “”, vbTextCompare)
lTopicend = InStr(1, sHTML, “”, vbTextCompare)
lon = Mid(sHTML, lTopicstart + 5, lTopicend – lTopicstart – 5)
GeoCode = status & “,” & lat & “,” & lon
Exit Function
End Function
Public Function rGeoCode(sLatLng As String) As String
Dim oHttp As Object
Dim sURL As String, sHTML As String
Dim sAddress As String
Dim lTopicstart As Long, lTopicend As Long
sURL = “http://maps.googleapis.com/maps/api/geocode/xml?latlng=” & sLatLng & “&sensor=false”
‘ Create an XMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject(“MSXML2.XMLHTTP”)
If Err.Number 0 Then
Set oHttp = CreateObject(“MSXML.XMLHTTPRequest”)
MsgBox “Error 0 has occured while creating a MSXML.XMLHTTPRequest object”
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox “For some reason I wasn’t able to make a MSXML2.XMLHTTP object”
Exit Function
End If
‘Open the URL in browser object
oHttp.Open “GET”, sURL, False
oHttp.Send
sHTML = oHttp.ResponseText
Set oHttp = Nothing
‘ Address
lTopicstart = InStr(1, sHTML, “”, vbTextCompare)
lTopicend = InStr(1, sHTML, “”, vbTextCompare)
If lTopicstart = 0 And lTopicend = 0 Then
lTopicstart = InStr(1, sHTML, “”, vbTextCompare)
lTopicend = InStr(1, sHTML, “”, vbTextCompare)
sAddress = Mid(sHTML, lTopicstart + 8, lTopicend – lTopicstart – 8)
Else
sAddress = Mid(sHTML, lTopicstart + 19, lTopicend – lTopicstart – 19)
End If
rGeoCode = sAddress
End Function
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = “+” Else Space = “%20″
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = “%0″ & Hex(CharCode)
Case Else
result(i) = “%” & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, “”)
End If
End Function
sorry — in the Geocode functions, some of the tags were deleted. Where it searches for the status code, there should be a “status” start tag, and “/status” tag. In the lat searches, there is “lat” start tag and “/lat”. And a start “lng” and “/lng” tag.
in the reverse geocode, it should search for the start tag “formattedaddress” and an “/formattedaddress” tag.
I’m new to VBA. Could you please publish a link to a sample xls file with full code in?
On more fix to Eds code.
Change line
Set oHttp = CreateObject(“MSXML2.XMLHTTP”)
to
Set oHttp = CreateObject(“MSXML2.ServerXMLHTTP”)
This will help you to solve some encoding problems. For example URLEncode function doesn’t help to encode some danish letters.
I would like to use your code to retrieve geo-location information within Malta (EU), however, your code does not seem to retrieve it, does it depend on Google API?
I would need to calculate the shortest distance between two Geolocations, hence, require information related to the
a) geo-locations of different points
b) roads that have to be travelled to get from point A to point B
Your help would be appreciated.
You can download a workbook that will geocode and plot data directly out of excel here.
http://ramblings.mcpher.com/Home/excelquirks/getmaps/mapmarkers
Bruce