Recently my boss asked me to come up with a way to show certain information on a map of some kind, and after doing some research I decided to simply create a KML file and use Google Earth. In order to create the KML file, I needed latitude and longitude of each address I was going to display. I found a couple of different free services, and I decided to use the one from Google.
The Google Geocode service is using a REST API, so it was easy to write some code to send address and retrieve XML with (among other things) latitude and longitude. An additional benefit is that the address get check and modified, so if the ZIP is off, or the name of the street is not “Street” but “Drive”, the correct values get returned.
You need tosign up to get your own key from Google, but it is free.
Today I decided to write a small class to do this lookup, so now I can add this to any program I write. Below is the code for the script library, as well as a small code sample how to call it. Enjoy!
Update: I have updated the code below to the latest version, as of March 5, 2013.
Dim geodata As GeoData
Set geodata = New GeoData("6363 North State Highway 161", "Irving", "tx", "")
If geodata.IsValid Then
Msgbox geodata.Street & Chr$(13) & geodata.City & ", " & geodata.State & " " & geodata.ZIP,, _
"Accuracy = " & geodata.AccuracyMsgbox "Lat: " & geodata.Latitude & " Longitude: " & geodata.Longitude
End If
And here is the class, I suggest to put it in a script library.
Option Public
Option Declare
Class GeoData
Private GeoString As String
Public street As String
Public city As String
Public zip As String
Public state As String
Public latitude As String
Public longitude As String
Public errmsg As String
Public warnmsg As String
Public Sub New(streetStr As String, cityStr As String, stateStr As String, zipStr As String)
Dim httpObject As Variant
Dim mapsKey As String
Dim mapsURL As String
Dim address As String
Dim retries As Integer
Dim httpURL As String
Dim returncode As String
Dim coordinates As String
Dim ret As Integer
Dim xmladdress As String
Dim addarray As Variant
Dim success As Integer
retries = 0
errmsg = ""
warnmsg = ""
'*** Use Win32 COM object to do HTTP calls
Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
mapsKey = ""
mapsUrl = "http://maps.google.com/maps/geo?q="
address = streetStr & ", " & cityStr & ", " & stateStr & " " & zipStr
httpURL = mapsURL & address & "&output=xml"
success = False
Do
'*** After the two first calls, introduce a 1 second delay between calls
If retries>1 Then
Sleep 1
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
GeoString = Left$(httpObject.responseText,16000)
returncode = GetGeoValue("code")
If returncode = "200" Then
success = True
errmsg = ""
ElseIf returncode = "500" Then
errmsg ="[Google GeoCode Error " & returncode & "] - " _
"A geocoding or directions request could not be successfully processed, " _
"yet the exact reason for the failure is unknown."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf returncode = "601" Then
errmsg ="[Google GeoCode Error " & returncode & "] - An empty address was specified."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf returncode = "602" Then
errmsg ="[Google GeoCode Error " & returncode & "] - " _
"No corresponding geographic location could be found for the specified address, " _
"possibly because the address is relatively new, or because it may be incorrect."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf returncode = "603" Then
errmsg ="[Google GeoCode Error " & returncode & "] - " _
"The geocode for the given address or the route for the given directions query " _
"cannot be returned due to legal or contractual reasons."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf returncode = "610" Then
errmsg ="[Google GeoCode Error " & returncode & "] - The given key is either " _
"invalid or does not match the domain for which it was given."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf returncode = "620" Then
errmsg ="[Google GeoCode Error " & returncode & "] - The given key has gone over the requests " _
"limit in the 24 hour period or has submitted too many requests in too short a period of time."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
ElseIf retries >= 10 Then
errmsg ="[Google GeoCode Error " & returncode & "] - " _
"The geocoding function timed out." & Chr$(13) & _
"This usually indicate a problem with the internet connection or the geocode server, " & _
"or that the suite number is on the first address line, confusing the server."
latitude = ""
longitude = ""
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
success = True
End If
Loop Until success = True
If returncode = "200" Then
coordinates = GetGeoValue("coordinates")
latitude = Left$(coordinates, InStr(coordinates,",")-1)
longitude = Mid$(coordinates, Len(latitude)+2, InStr(Len(latitude)+2,coordinates,",")-Len(latitude)-2)
street =GetGeoValue("ThoroughfareName")
zip = GetGeoValue("PostalCodeNumber")
city = GetGeoValue("LocalityName")
state = GetGeoValue("AdministrativeAreaName")
xmladdress = GetGeoValue("address")
If street = "" Or zip="" Then
warnmsg ="[Warning] - The street address could not be verified." & Chr$(13) & _
"Existing value will be saved." & Chr$(13) & "Please verify that address is correct."
street = streetStr
latitude = ""
longitude = ""
ElseIf city = "" Then
If state <> "" Then
addarray = Split(xmladdress,", ")
city = addarray(UBound(addarray)-2)
zip = Right$(addarray(UBound(addarray)-1),5)
End If
End If
If UCase(state)<>UCase(stateStr) Then ' Different state?
warnmsg = "[Warning] - The address returned seems to be very different from the one submitted." & _
Chr$(13) & "Address submitted: " & Chr$(13) & streetStr & Chr$(13) & cityStr & ", " & stateStr & _
" " & zipStr & Chr$(13) & "Address returned: " & Chr$(13) & street & Chr$(13) & city & ", " & _
state & " " & zip
street = streetStr
zip = zipStr
city = cityStr
state = stateStr
latitude = ""
longitude = ""
End If
If city = "" Then
warnmsg ="[Warning] - The city could not be verified." & Chr$(13) & _
"Existing value will be saved." & Chr$(13) & "Please verify that address is correct."
city = cityStr
latitude = ""
longitude = ""
End If
End If
End Sub
Public Function Accuracy() As Integer
Dim startpos As Long
Dim endpos As Long
If IsValid = False Then
Accuracy = 0
Exit Function
End If
startpos = InStr(LCase(GeoString),|accuracy="|) + 10
endpos = InStr(startpos, LCase(GeoString), |"|)
If endpos < startpos Then
Accuracy = 0
Else
Accuracy = CInt(FullTrim(Mid$(GeoString,startpos, endpos - startpos)))
End If
End Function
Public Function HasAddInfo(address As String) As Integer
If InStr(LCase(address),"apt")>0 Then
HasAddInfo = True
ElseIf InStr(LCase(address),"apartment ")>0 Then
HasAddInfo = True
ElseIf InStr(LCase(address),"suite ")>0 Then
HasAddInfo = True
ElseIf InStr(LCase(address),"ste ")>0 Then
HasAddInfo = True
ElseIf InStr(LCase(address)," #")>0 Then
HasAddInfo = True
ElseIf InStr(LCase(address),", ")>0 Then
HasAddInfo = True
Else
HasAddInfo = False
End If
End Function
Public Function IsValid() As Integer
If GeoString = "" Then
IsValid = False
Else
IsValid = True
End If
End Function
Public Function GetGeoValue(tag As String) As String
Dim startpos As Long
Dim endpos As Long
Dim tempstring As String
If GeoString = "" Then
GetGeoValue = ""
Exit Function
End If
startpos = InStr(LCase(GeoString),"< " & LCase(tag) & ">") + Len(tag)
endpos = InStr(startpos, LCase(GeoString), "")
If endpos < startpos Then
GetGeoValue = ""
Else
tempstring = FullTrim(Mid$(GeoString,startpos+2, endpos - startpos - 2))
GetGeoValue = FullTrim(Replace(tempstring,"&","&"))
End If
End Function
End Class