Option Compare Database   'Use database order for string comparisons
Option Explicit
Global glbCriteria As String, glbSubName As String, glbSearchType As Integer

Private Function Equiv () As String
    Select Case Forms![frmSearchForm]![optEquiv]
    Case 1
        Equiv = " = "
    Case 2
        Equiv = " > "
    Case 3
        Equiv = " < "
    End Select
End Function

Function LookFor ()
    ' call this from the on click event of the search button on the main form
    Dim D As Database, R As Recordset, Thing As String
    Dim Enfant As String, Pere As String, SubCount As Integer
    Dim F As Form, SubF As Form, sSQL As String
    
    On Error GoTo LookFor_Trap
    Set F = Screen.ActiveForm
    
    If TypeOf Screen.PreviousControl Is Subform Then
        Enfant = Screen.PreviousControl.LinkChildFields
        Pere = Screen.PreviousControl.LinkMasterFields
        Set SubF = Screen.PreviousControl.Form
        glbSearchType = SubF.Recordsetclone(glbSubName).Properties!Type
        glbCriteria = ""
        DoCmd OpenForm "frmSearchForm", , , , , A_DIALOG, glbSubName
        If Len(glbCriteria) = 0 Then GoTo LookFor_GetOut
        sSQL = "SELECT " & Enfant & " FROM " & SubF.RecordSource & " WHERE " & glbCriteria
        DoCmd Hourglass True
        Set D = DbEngine(0)(0)
        Set R = D.OpenRecordset(sSQL)
        If R.Recordcount = 0 Then
            MsgBox "No match in SubForm", , "Search"
            R.Close
            GoTo LookFor_GetOut
        End If
        glbCriteria = ""
        SubCount = 0
        Do Until R.EOF Or SubCount > 900
            If glbCriteria > "" Then glbCriteria = glbCriteria & ","
            glbCriteria = glbCriteria & R(Enfant)
            R.MoveNext
            SubCount = SubCount + 1
        Loop
        glbCriteria = Pere & " in (" & glbCriteria & ")"
        DoCmd Hourglass False

    ElseIf TypeOf Screen.PreviousControl Is CommandButton Then
        GoTo LookFor_Search
    Else
        Thing = Screen.PreviousControl.ControlSource
        glbSearchType = F.Recordsetclone(Thing).Properties!Type
        If glbSearchType = 11 Then
            MsgBox "Binary field " & Thing & " cannot be searched.", , "Search"
            GoTo LookFor_GetOut
        End If
        glbCriteria = ""
        DoCmd OpenForm "frmSearchForm", , , , , A_DIALOG, Thing
    End If
    
LookFor_Search:
    DoCmd Hourglass True
    If glbCriteria > "" Then
        Set R = F.Recordsetclone
        R.Bookmark = F.Bookmark
        R.FindNext glbCriteria
        If R.NoMatch Then
            MsgBox "Reached end of file.  Moving to first record.", , "Search"
            R.MoveFirst
            F.Bookmark = R.Bookmark
        Else
            F.Bookmark = R.Bookmark
        End If
        R.Close
    End If

LookFor_GetOut:
    DoCmd Hourglass False
    Exit Function
LookFor_Trap:
    If Err = 2427 Or Err = 2467 Or Err = 3265 Then
        Resume LookFor_Search
    ElseIf Err = 3077 Then
        MsgBox "Criteria too broad", , "Search Error"
        Resume LookFor_GetOut
    Else
        MsgBox Error & " in LookFor", , "Search Error"
        Resume LookFor_GetOut
    End If

End Function

Function qwkSearch ()
    ' called from the search form after user input
    Dim F As Form
    Set F = Forms![frmSearchForm]
    If IsNull(F!toFind) Then GoTo btnSearch_Nothing
    If Len(F!toFind) = 0 Then GoTo btnSearch_Nothing
    On Error GoTo btnSearch_trap

    Select Case glbSearchType
        Case 1 To 7                         'NUMERIC
            If IsNumeric(F!toFind) Then
                glbCriteria = Equiv() & F!toFind
            Else
                MsgBox "Please enter a number", , "Search"
                Exit Function
            End If
        Case 8                              'DATE
            If IsDate(F!toFind) Then
                glbCriteria = Equiv() & "#" & F!toFind & "#"
            Else
                MsgBox "Please enter a date", , "Search"
                Exit Function
            End If
        Case 10, 12                         'TEXT,MEMO
            If InStr(F!toFind, "*") > 0 Then
                glbCriteria = " Like """ & F!toFind & """"
            Else
                glbCriteria = " = """ & F!toFind & """"
            End If
    End Select
    
    If glbCriteria > "" Then glbCriteria = StuffBrack(F.OpenArgs) & glbCriteria

btnSearch_GetOut:
    DoCmd Close A_FORM, "frmSearchForm"
    Exit Function
btnSearch_Nothing:
    If MsgBox("Nothing to search for.  Cancel?", 36, "Search") = 6 Then GoTo btnSearch_GetOut
    Exit Function
btnSearch_trap:
    MsgBox Error & " in btnSearch_Click of frmSearchForm"
    Exit Function

End Function

Private Function StuffBrack (Fld As Variant) As String
    Dim Dot As Integer
    On Error GoTo StuffBrack_Trap
    If Len(Fld) = 0 Then
        StuffBrack = "No_Field"
        Exit Function
    End If
    If InStr(Fld, "[") Then
        StuffBrack = Fld
    Else
        Dot = InStr(Fld, ".")
        If Dot > 0 Then
            StuffBrack = "[" & Left(Fld, Dot - 1) & "].[" & Right(Fld, Len(Fld) - Dot) & "]"
        Else
            StuffBrack = "[" & Fld & "]"
        End If
    End If

StuffBrack_GetOut:
    Exit Function
StuffBrack_Trap:
    StuffBrack = "Unknown_Field"
    Resume StuffBrack_GetOut:
End Function

Function SubFormControl ()
    ' call this from the on exit event of each subform you wish to search
    On Error Resume Next
    glbSubName = Screen.ActiveControl.ControlSource
End Function

