Programming Tool Box/SIMS_2.iso/access/diverses/sbfrmf/sbfrmfnd.txt

Text File | 1995-02-26 | 6KB | 113 lines

Function SearchSubFormEnhanced ()
    Dim strCriteria As String, strField  As String, strLinkChild As String
    Dim strLinkMaster As String, rsForm  As Recordset, rsSubForm As Recordset
    Dim strSearchValue As String, i As Integer, db As Database, varLinkValue As Variant
    Static strOldCriteria As String, OrgID, ContID, Searchfield As Control, strOldSearchValue As String
    Dim Criteria As String

    '**** Purpose of code is to display main form records corresponding to
    '**** values searched for on the subform. This overcomes the normal Access
    '**** limitation of the Edit, Find facility.
    '**** To use, change the form name 'Organisations Form', subform name "Contacts" and fields
    '**** OrganisationID, ContactID and table Contacts to suit your application, then call from a menu.
    '**** If you call from a button, use PreviousControl instead of ActiveControl.
    '**** To find the next or previous match enter "/" or "\" as the search value.
    '**** Cursor should be placed in field to be searched.

    '**************************************************************************************************
    'Author: Charles Kangai
    '        Blueneck Computer Training & Consulting Services
    '        9 Chandos Road
    '        Redland
    '        Bristol, UK
    '        Compuserve: 100424,1710 Internet: [e-mail]
    '        Tel: [phone] Fax: [phone] Int'l: Tel/Fax: [phone]
    '**************************************************************************************************

    On Error GoTo ErrorSearchSubForm
    'Identify the name of the control being searched
    'and the names of the fields involved in the linking relationship

    strField = Screen.activecontrol.Name  'Use PreviousControl if you call function from a button
    strLinkChild = CStr(Me![Contacts].LinkChildFields)
    strLinkMaster = CStr(Me![Contacts].LinkMasterFields)
    strSearchValue = InputBox$("Please enter value to search for:", "Searching in " & strField)
    If strSearchValue = "" Then Exit Function

    'Build the search criteria and search
    'Note that you search the underlying table or query of the subform.
    'You don't search the recordset clone of the subform, as this only holds
    'records matching the current main form record.

    Set db = dbEngine(0)(0)
    Set rsSubForm = db.OpenRecordset("Contacts", DB_OPEN_DYNASET)
    strCriteria = strField & " like " & Chr$(39) & strSearchValue & Chr$(42) & Chr$(39)
    Select Case strSearchValue
        Case "/"
            'Find next
            If IsEmpty(OrgID) Or IsEmpty(ContID) Then Exit Function  'Use selected to Find Next before the initial Find
            strCriteria = strOldCriteria
            'If your OrgID and ContactID fields are strings, you must have: strOldCriteria = "[OrganisationID] = " & """" & OrgID & """" & " AND [ContactID] = " & """" & ContID & """"
            strOldCriteria = "[OrganisationID] = " & OrgID & " AND [ContactID] = " & ContID
            'First, locate where you got to last time.
            rsSubForm.FindFirst strOldCriteria
            'Then find the next record
            rsSubForm.FindNext strCriteria
        Case "\"
            'Find previous
            If IsEmpty(OrgID) Or IsEmpty(ContID) Then Exit Function  'Use selected to Find Next before the initial Find
            strCriteria = strOldCriteria
            strOldCriteria = "[OrganisationID] = " & OrgID & " AND [ContactID] = " & ContID
            'First locate where you got to last time
            rsSubForm.FindFirst strOldCriteria
            'Then find the previous record
            rsSubForm.FindPrevious strCriteria
        Case Else
            'This is a new search.  Save the criteria before searching.
            strOldSearchValue = strSearchValue
            strOldCriteria = strCriteria
            Set Searchfield = Screen.activecontrol
            rsSubForm.FindFirst strCriteria
    End Select

    'On finding the subform record, note the value of the subform link field.
    'This value will have a match on the main form.

    If Not rsSubForm.nomatch Then
        'Save the main record primary key and subform record primary key
        'This enables you to search for the next record next time round.
        OrgID = rsSubForm!OrganisationID
        ContID = rsSubForm!ContactID
        For i = 0 To rsSubForm.Fields.count - 1
            If rsSubForm.Fields(i).Name = strLinkChild Then
                varLinkValue = rsSubForm.Fields(i).value
                Exit For
            End If
        Next

        'On the main form, search for the record with the matching link field value.
        'Use the bookmark property to display that record.

        Set rsForm = Me.recordsetclone
        strCriteria = strLinkMaster & " like " & Chr$(39) & varLinkValue & Chr$(42) & Chr$(39)
        rsForm.FindFirst strCriteria
        If Not rsForm.nomatch Then
            Me.bookmark = rsForm.bookmark
            '******This block is optional. Only use if you want to also highlight the subform record.
            'Move focus to search field.
            Searchfield.SetFocus
            DoCmd FindRecord strOldSearchValue
            '*******End of optional block
        End If
    End If
ExitSearchSubForm:
    Exit Function
ErrorSearchSubForm:
    If Err = 3070 Then
        MsgBox "Check that you are on a subform field!"
    Else
        MsgBox Str$(Err) & " " & Error$
    End If
    Resume ExitSearchSubForm
End Function