Results 1 to 1 of 1
Thread: The Contacts list
2009-11-10, 15:45 #1
- Join Date
- Feb 2001
- Yilgarn region of Toronto, Ontario
- Thanked 0 Times in 0 Posts
I threw this little bit of code together this afternoon.
I'm meeting a friend for coffee 2pm Thursday downtown, and found myself thinking who else is nearby that I might meet for lunch beforehand, and possibly another contact for coffee at 10:30.
Since my 2pm friend and I are meeting at The Royal York Hotel (postal code "M5J 1E3"), it becomes a loose question of "Who else is based near 'M5J 1E3'"?
The loose answer is to be found in the procedure DumpLevel, which locates all records which match a given generic mask, and in the WHILE loop of the procedure TestProcessDatabase, which loops creating an ever-widening set of contacts from an ever more-generic mask until a sufficient number of nearby contacts has been found.
This is not a neat solution, since (in Canada at least) postal codes can differ on opposite sides of the street, but at least it gives me a clue as to who I might 'phone for a meeting.
The attached TXT file will be of interest only to Torontonians; it shows the street addresses brought up by my search I stripped out names & phone numbers). Torontonians will recognize that Royal York Hotel to Bloor street is a pretty large area, none the less I can recognize that Richmond street and King street are good candidates, a short walk away from the Royal York Hotel.
Sub TestProcessDatabase() Dim wrk As Workspace Set wrk = wrkCreateWrk Dim dbs As Database Set dbs = dbsOpenDatabase(wrk, strFixPath(ThisDocument.Path), "Clients3.mdb") Dim strTargetPostalCode As String strTargetPostalCode = UCase(InputBox("Please enter a properly-formatted postal code", "TestProcessDatabase", "M4W 1E5")) Dim strAr() As String ReDim strAr(0) While (Len(strTargetPostalCode) > 0) And (UBound(strAr) < 20) Call DumpLevel(strTargetPostalCode, dbs, strAr) strTargetPostalCode = Left(strTargetPostalCode, Len(strTargetPostalCode) - 1) Wend Dim lng As Long For lng = LBound(strAr) To UBound(strAr) - 1 Selection.TypeText (strAr(lng)) & vbCrLf Next lng End Sub Function DumpLevel(strTargetPostalCode As String, dbs As Database, strAr() As String) ReDim strAr(0) Dim rst As Recordset Dim strSelect As String strSelect = "SELECT * FROM CLIENT " strSelect = strSelect & " WHERE POSTCODE LIKE '" & strTargetPostalCode & "*'" Set rst = rstOpenRecordset(dbs, strSelect) With rst If .RecordCount > 0 Then .MoveFirst While Not .EOF strAr(UBound(strAr)) = .Fields("GIVEN") & vbTab & .Fields("SURN") & vbTab & .Fields("BUSINESS") & vbTab & .Fields("ADDRESS") & vbTab & .Fields("PHONE") ReDim Preserve strAr(UBound(strAr) + 1) .MoveNext Wend Else End If End With End Function