'Comments  : Designed to be more flexible than DLookup.
'            Search method based on Trevor Best's improved DLookup function, tLookup.
'Parameters: strTable - name of domain to search
'            strCriteria - "Where" clause for SQL statement; in DLookup, this is not required, in MultiLookup, it is
'            strFields - any number of desired fields to return values from; for now, does not test for empty array
'Sets      :
'Returns   : An array (variant) of several field values as specified in strFields().
'Created by: Seth D. Galitzer
'Created   : 9/3/1998 10:55:45 AM
'Modified  :
Public Function basMultiLookup(strTable As String, strCriteria As String, ParamArray strFields() As Variant) As Variant
On Error GoTo Err_basMultiLookup
    Dim dbs As Database
    Dim rst As Recordset
    Dim strArgs As String
    Dim strSQL As String
    Dim varItem As Variant
    Dim varRetVal() As Variant
    Dim intI As Integer
    'Dim fNull As Boolean

    'fNull = False

    For Each varItem In strFields()         'iterate through field array and generate list for SQL statement
        strArgs = strArgs & varItem & ", "
    Next varItem
    
    ReDim varRetVal(UBound(strFields))      'set the size of the return array

    strArgs = Left(strArgs, Len(strArgs) - 2)   'strip the trailing ", " from the SQL field list
    
    strSQL = "SELECT " & strArgs & " FROM " & strTable & " WHERE " & strCriteria    'generate SQL statement

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
    If Not rst.BOF Then
        rst.MoveFirst
        For intI = 0 To UBound(strFields())         'iterate through field array to get recorset field names
            varRetVal(intI) = rst(strFields(intI))  'fill return array in same order as field array
        Next intI
        basMultiLookup = varRetVal
    Else
        basMultiLookup = Null       'if not found, set to null; tried to imitate DLookup, does not behave the same
    End If

Exit_basMultiLookup:
    If Not (rst Is Nothing) Then        'Garbage handling
        rst.Close
        Set rst = Nothing
    End If
    If Not (dbs Is Nothing) Then
        Set dbs = Nothing
    End If
Exit Function

Err_basMultiLookup:
    Select Case Err
    Case 0      'insert Errors you wish to ignore here
        Resume Next
    Case Else   'All other errors will trap
        Beep
        MsgBox Err.Description, vbCritical, "Error in function modGenericFunctions.basMultiLookup"
        Resume Exit_basMultiLookup
    End Select
    Resume 0    'FOR TROUBLESHOOTING
End Function

========================Begin Sample Usage==========================================

Private Sub txtNumber_AfterUpdate()
On Error GoTo Err_txtNumber_AfterUpdate
    Const conViolMeter = 2
    Const conIdxAmt = 0
    Const conIdxDesc = 1
    Const conIdxCode = 2
    
    Dim strTableName As String
    Dim strCriteria As String
    Dim intVCode As Integer
    Dim varReturned As Variant
    
    strTableName = "tblTickets"

    strCriteria = "[TKTNUMBER] Like '" & Me!txtNumber & "'"

    Select Case Me!cboTransType
        Case conTTParkMisuse, conTTMeter, conTTBike	'these constants are defined globally
            varReturned = basMultiLookup(strTableName, strCriteria, "AMOUNTOWED", "CODEDES", "VCODE")
            If Not IsNull(varReturned) Then		'test for null
                Me!txtAmount = varReturned(conIdxAmt)	'use returned values in array
                Me!txtDesc = varReturned(conIdxDesc)
                intVCode = CInt(varReturned(conIdxCode))
                If intVCode = conViolMeter Then
                    Me!cboTransType = conTTMeter
                End If
                If basIsBikeMisuse(intVCode) Then
                    Me!cboTransType = conTTBike
                End If
            Else
                Beep
                MsgBox "Unable to find this ticket.@Make sure you entered the number correctly.@", vbExclamation, "Ticket not Found"
                GoTo Exit_txtNumber_AfterUpdate
            End If
    End Select
    
Exit_txtNumber_AfterUpdate:
Exit Sub

Err_txtNumber_AfterUpdate:
    Select Case Err
    Case 0      'insert Errors you wish to ignore here
        Resume Next
    Case Else   'All other errors will trap
        Beep
        MsgBox Err.Description, vbCritical, "Error in function Form_frmReceiptDetails.txtNumber_AfterUpdate"
        Resume Exit_txtNumber_AfterUpdate
    End Select
    Resume 0    'FOR TROUBLESHOOTING
End Sub