VERSION 5.00
Begin VB.Form frmZipCode
Caption = "Zip Codes"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 7185
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 7185
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtZipcode
Height = 330
Left = 210
MaxLength = 5
TabIndex = 4
Top = 2010
Width = 1725
End
Begin VB.CommandButton cmdLookUp
Caption = "LookUp"
Height = 420
Left = 210
TabIndex = 2
Top = 1500
Width = 1920
End
Begin VB.CommandButton cmdOpenZipcode
Caption = "Open Zip Code"
Height = 420
Left = 210
TabIndex = 0
Top = 285
Width = 1920
End
Begin VB.Label lblCityState
Height = 360
Left = 2280
TabIndex = 3
Top = 1545
Width = 4770
End
Begin VB.Label lblError
Height = 870
Left = 2340
TabIndex = 1
Top = 330
Width = 4665
End
End
Attribute VB_Name = "frmZipCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private objZip As New clsZipcode
Private Sub cmdLookUp_Click()
Dim strCityState As String
Dim I As Long
Debug.Print Now & " start"
For I = 0 To 1000
strCityState = objZip.Lookup(txtZipcode.Text)
Next
Debug.Print Now & " End"
lblCityState = strCityState
End Sub
Private Sub cmdOpenZipcode_Click()
On Error Resume Next
objZip.OpenZip App.Path & "\zips.txt"
lblError = Err.Description
On Error GoTo 0
End Sub
Private Sub Form_Load()
cmdLookUp.Enabled = False
End Sub
Private Sub txtZipcode_Change()
cmdLookUp.Enabled = Len(txtZipcode.Text) = 5
End Sub
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsZipcode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mstrCityStateZip As String
Sub OpenZip(strFileName As String)
Dim lngHandle As Long
Dim strResponse As String
Dim strWhile As String
Dim strFips As String
Dim strZipcode As String
Dim strState As String
Dim strCity As String
Dim strLongitude As String
Dim strLatitude As String
Dim strPopulation As String
Dim strAllocation As String
Dim strCityPrev As String
Dim strStatePrev As String
Dim lngIndex As Long
Dim lngLenCS As Long
Dim aryCityStateZip() As String
ReDim aryCityStateZip(0)
lngIndex = 0
Do
lngHandle = FreeFile
strWhile = " Opening"
On Error Resume Next
Open strFileName For Input Access Read As lngHandle
strResponse = Err.Description
On Error GoTo 0
If Len(strResponse) > 0 Then Exit Do
Do While (Not EOF(lngHandle))
strWhile = "Reading"
On Error Resume Next
Input #lngHandle, strFips, strZipcode, strState, strCity, _
strLongitude, strLatitude, _
strPopulation, strAllocation
strResponse = Err.Description
On Error GoTo 0
If Len(strResponse) > 0 Then Exit Do
If strState <> strStatePrev Or strState <> strStatePrev Then
lngIndex = lngIndex + 1
If lngIndex > UBound(aryCityStateZip) Then
ReDim Preserve aryCityStateZip(lngIndex * 2)
End If
aryCityStateZip(lngIndex) = "<" & strCity & "," & strState & ">," & strZipcode
Else
aryCityStateZip(lngIndex) = aryCityStateZip(lngIndex) & "," & strZipcode
End If
strCityPrev = strCity
strStatePrev = strStatePrev
Loop
If Len(strResponse) > 0 Then Exit Do
Exit Do: Loop
ReDim Preserve aryCityStateZip(lngIndex)
On Error Resume Next
Close lngHandle
On Error GoTo 0
If Len(strResponse) > 0 Then
strResponse = strResponse & vbCrLf & _
"while " & strWhile & vbCrLf & _
strFileName
Err.Raise vbObjectError + 513, "clsZipcode", strResponse
End If
mstrCityStateZip = Join(aryCityStateZip, ",")
lngLenCS = Len(mstrCityStateZip)
End Sub
Public Function Lookup(strZipcode As String) As String
Dim I As Long
Dim J As Long
I = InStr(1, mstrCityStateZip, strZipcode)
If I = 0 Then Exit Function
I = InStrRev(mstrCityStateZip, "<", I)
If I = 0 Then Exit Function
J = InStr(I, mstrCityStateZip, ">")
Lookup = Mid$(mstrCityStateZip, I + 1, J - I - 1)
End Function