Zip code Functions for VBA

Haven't posted anything to my blog in a while... so here it goes.

I figured that I would contribute some of my code (albeit pretty horrible code) for those who use VBA. I personally don't care much for VBA, but I use it a lot to do some pretty neat stuff in Excel. Anyway... these VBA functions utilize Microsoft's XMLHTTP Object to get some valuable geographic/zip code information.

I have provided a few VBA functions. Some of these functions are definitely hacks, as they assume that the USPS website's structure will remain the same. Although, in my opinion, since USPS.com is run by the US government, it probably won't change any time soon. :)

1. Function GetCityState(zipcode As String)
   This function connects to the USPS.com website to get the city and state abbreviation for the zip code provided.
   
2. Function GetZipcode(address As String, city As String, stateAbbr As String) As String
   This function connects the USPS.com website and tries to get the zip code, given a street address, city, and state abbreviation. The address need not match exactly; it just has to be close enough for the USPS search engine to guess.
   
3. Function IsZipCode(data As String) As Boolean
   Will return true if the input is a 5-digit numeric zip code with leading zeros, a 10-character zip code with format "xxxxx-yyyy", or a Canadian zip code with format "xyx yxy" where x is a letter and y is a number
4. Function GetGeocode(zipcode As String) As String
   Goes to maps.google.com and returns the latitude and longitude of a central point in the zip code specified.
5. Function GetGeocodeXML(zipcode As String) As String
   Prints out some information (in XML format) about the zip code provided. See the Google Maps API for more details.

OK... Here's the code...
https://blakecomserver.redirectme.net/svn/public/VBA/ZipcodeFunc.bas

Function GetCityState(zipcode As String) As String
Dim xmlHttp As New XMLHTTP60
Dim xmlText As String
Dim currPos As Long
Dim stopPos As Long

'Validate input
If Not IsZipCode(zipcode) Then Exit Function
If Len(zipcode) = 10 Then zipcode = Left(zipcode, 5)
If Len(zipcode) <> 5 Then Exit Function

xmlHttp.Open "GET", "http://zip4.usps.com/zip4/zcl_3_results.jsp?zip5=" & zipcode, False
xmlHttp.send
xmlText = xmlHttp.responseText
currPos = 1
currPos = InStr(currPos, xmlText, "<html") + 1
currPos = InStr(currPos, xmlText, "<body") + 1
currPos = InStr(currPos, xmlText, "<form") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<div") + 1
currPos = InStr(currPos, xmlText, "<table") + 1
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<td") + 1
currPos = InStr(currPos, xmlText, "<b") + 1
stopPos = InStr(currPos, xmlText, "</b>")
currPos = currPos + 2
If stopPos = 0 Then
GetCityState = ""
Else
GetCityState = Mid(xmlText, currPos, stopPos - currPos)
'Validate output
If InStr(GetCityState, ", ") = 0 Then GetCityState = ""
End If
End Function
Function GetZipcode(address As String, city As String, stateAbbr As String) As String
Dim xmlHttp As New XMLHTTP60
Dim xmlText As String
Dim currPos As Long
Dim stopPos As Long
Dim i As Integer

'Validate/correct input
address = UCase(address)
city = UCase(city)
stateAbbr = UCase(stateAbbr)
address = Replace(address, "&", "")
address = Replace(address, "=", "")
address = Replace(address, ";", "")
address = Replace(address, """", "")
If Len(stateAbbr) <> 2 Then Exit Function

xmlHttp.Open "GET", "http://zip4.usps.com/zip4/zcl_0_results.jsp?pagenumber=0&firmname=&address1=&address2=" & address & "&city=" & city & "&state=" & stateAbbr & "&zip5=&urbanization=", False
xmlHttp.send
xmlText = xmlHttp.responseText
currPos = 1
currPos = InStr(currPos, xmlText, "<html") + 1
currPos = InStr(currPos, xmlText, "<body") + 1
For i = 1 To 11
currPos = InStr(currPos, xmlText, "<div") + 1
Next i
currPos = InStr(currPos, xmlText, "<table") + 1
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<th") + 1
currPos = InStr(currPos, xmlText, "<th") + 1
currPos = InStr(currPos, xmlText, "<h2>ZIP + 4 Code</h2>") + 1
If currPos = 1 Then
'<h2>ZIP + 4 Code</h2> was not found. This may only have one zipcode possibility
currPos = InStr(currPos, xmlText, "<html") + 1
currPos = InStr(currPos, xmlText, "<body") + 1
currPos = InStr(currPos, xmlText, "<form") + 1
For i = 1 To 7
currPos = InStr(currPos, xmlText, "<div") + 1
Next i
currPos = InStr(currPos, xmlText, "<table") + 1
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<td") + 1
currPos = InStr(currPos, xmlText, "<br") + 1
currPos = InStr(currPos, xmlText, "&nbsp;&nbsp;") + 1
currPos = currPos + 11
Else
'Find the first zipcode in the list
currPos = InStr(currPos, xmlText, "<tr") + 1
currPos = InStr(currPos, xmlText, "<td") + 1
currPos = InStr(currPos, xmlText, "<td") + 1
currPos = InStr(currPos, xmlText, ">") + 1
End If
stopPos = InStr(currPos, xmlText, "-")
If stopPos = 0 Then
GetZipcode = ""
Else
GetZipcode = Replace(Mid(xmlText, currPos, stopPos - currPos), Chr(9), "")
GetZipcode = Replace(GetZipcode, Chr(10), "")
GetZipcode = Replace(GetZipcode, Chr(13), "")
GetZipcode = Trim(GetZipcode)
'Validate output
If Len(GetZipcode) <> 5 Then
GetZipcode = ""
ElseIf Not IsZipCode(GetZipcode) Then
GetZipcode = ""
End If
End If
End Function
Function IsZipCode(data As String) As Boolean
'Will check to see if this specified data matches the one of the following:
' A 5-digit numeric zip code with leading zeros
' A 10-character zip code with format "xxxxx-yyyy"
' A Canadian zip code with format "xyx yxy" where x is a letter and y is a number
Dim firstFive As String
Dim lastFour As String

If Len(data) = 5 And IsNumeric(data) Then
IsZipCode = (Format(Int(data), "00000") = data)
' ElseIf Len(data) = 9 And IsNumber(data) Then
' IsZipCode = (Format(Int(data), "000000000") = data)
ElseIf Len(data) = 10 And Mid(data, 6, 1) = "-" Then
firstFive = Left(data, 5)
lastFour = Right(data, 4)
If IsNumeric(firstFive) And IsNumeric(lastFour) Then
IsZipCode = (Format(Int(firstFive), "00000") = firstFive) And (Format(Int(lastFour), "0000") = lastFour)
End If
ElseIf Len(data) = 7 Then
Dim numData As String
Dim letterData As String
Dim i As Integer
numData = Mid(data, 2, 1) & Mid(data, 5, 1) & Mid(data, 7, 1)
letterData = UCase(Mid(data, 1, 1) & Mid(data, 3, 1) & Mid(data, 6, 1))
'Remove numerics
For i = 48 To 57
numData = Replace(numData, Chr(i), "")
Next i
'Remove uppercase letters
For i = 65 To 90
letterData = Replace(letterData, Chr(i), "")
Next i
IsZipCode = (Len(numData & letterData) = 0)
Else
IsZipCode = False
End If
End Function
Function GetGeocode(zipcode As String) As String
Dim xmlHttp As New XMLHTTP60
Dim xmlText As String
Dim currPos As Long
Dim stopPos As Long

'Validate input
If Not IsZipCode(zipcode) Then Exit Function
If Len(zipcode) = 10 Then zipcode = Left(zipcode, 5)
If Len(zipcode) <> 5 Then Exit Function

xmlHttp.Open "GET", "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & zipcode, False
xmlHttp.send
xmlText = xmlHttp.responseText
currPos = 1
currPos = InStr(currPos, xmlText, "<result") + 1
currPos = InStr(currPos, xmlText, "<body") + 1
currPos = InStr(currPos, xmlText, "<geometry") + 1
currPos = InStr(currPos, xmlText, "<location") + 1
currPos = InStr(currPos, xmlText, "<lat") + 1
stopPos = InStr(currPos, xmlText, "</lat>")
currPos = currPos + 4
GetGeocode = Mid(xmlText, currPos, stopPos - currPos)
currPos = InStr(currPos, xmlText, "<lng") + 1
stopPos = InStr(currPos, xmlText, "</lng>")
currPos = currPos + 4
GetGeocode = GetGeocode & ", " & Mid(xmlText, currPos, stopPos - currPos)
End Function
Function GetGeocodeXML(zipcode As String) As String
Dim xmlHttp As New XMLHTTP60

'Validate input
If Not IsZipCode(zipcode) Then Exit Function
If Len(zipcode) = 10 Then zipcode = Left(zipcode, 5)
If Len(zipcode) <> 5 Then Exit Function

xmlHttp.Open "GET", "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & zipcode, False
xmlHttp.send
GetGeocodeXML = xmlHttp.responseText
End Function