Results 1 to 1 of 1
  1. #1
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    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.


    Code:
    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
    Attached Files Attached Files
    • File Type: txt 1.txt (723 Bytes, 4 views)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •