Attribute VB_Name = "Module1"
Option Explicit

Public pdbs As Database

Const APP_NAME = "Test Access Functions"

Function DLookup(ByVal FieldName As String, ByVal RecSource As String, _
                 ByVal Criteria As String) As Variant

'DLookup(expr, domain , criteria)
'
'   Argument Description
'   ----------------------------------------------------------------
'   expr       String expression identifying the field that contains
'              the data you want to return. Operands in expr can
'              include the name of a table field.
'
'   domain     String expression identifying the records that
'              constitute the record set. It can be a table name,
'              query name, or SQL expression that returns data.
'
'   criteria   Optional string expression used to restrict the range
'              of data on which DLookup is performed. For example,
'              criteria could be the SQL expression's WHERE clause
'              without the word WHERE. If criteria is omitted, DLookup
'              evaluates expr against the entire record set.
   
Dim dsResult As Recordset
Dim ReturnValue As Variant

   On Local Error GoTo Error_DLookup:

   ' Create a dynaset based on the record source or SQL string provided
   Set dsResult = pdbs.OpenRecordset(RecSource, dbOpenDynaset)

   With dsResult
      
      ' Check for a Criteria
      If Criteria = "" Then
         Criteria = FieldName & " Is Not Null"
      End If
      
      ' Find first record that meets criteria provided
      .FindFirst Criteria
   
      ' Check for records found
      If Not .NoMatch Then
   
         ' Found a match so return field value
         DLookup = dsResult(FieldName).Value
      Else
         DLookup = Null
      End If
      
      .Close
   End With
   
DLookup_Exit1:
   Exit Function

Error_DLookup:

   'Display the error and get out
   MsgBox "Error (" & Err & "): " & Error(Err) & " in DLookup", _
      vbCritical, APP_NAME
   
   Resume DLookup_Exit1:

End Function

Function DMax(ByVal strFieldName As String, ByVal strRecSource As String, _
    ByVal strCriteria As String) As Long
    
' DMax(expr, domain , criteria)
' Esample: vntReturnVal = DMax("Title", "Titles", "Au_ID = " & _
'          Format(data1.Recordset("Au_ID")))
'
'
'   Argument Description
'   ----------------------------------------------------------------
'   expr       String expression identifying the field that contains
'              the data you want to return. Operands in expr can
'              include the name of a table field.
'
'   domain     String expression identifying the records that
'              constitute the record set. It can be a table name,
'              query name, or SQL expression that returns data.
'
'   criteria   Optional string expression used to restrict the range
'              of data on which DMax is performed. For example,
'              criteria could be the SQL expression's WHERE clause
'              without the word WHERE. If criteria is omitted, DMax
'              evaluates expr against the entire record set.

Dim dsResult As Recordset
Dim vntCurrentVal As Variant

On Local Error GoTo Error_DMax:

    'Create a dynaset based on the record source or SQL string provided
    Set dsResult = pdbs.OpenRecordset(strRecSource, dbOpenDynaset)
    
    With dsResult
       
        'Find first record that meets criteria provided
        .FindFirst strCriteria
        
        'See if we found any records
        If Not .NoMatch Then
        
            ' Set variable vntCurrentVal
            vntCurrentVal = .Fields(strFieldName)
            
            Do While Not .EOF
            
                ' Cycle through each value from the row to find the largest
                If .Fields(strFieldName) > vntCurrentVal Then
                   vntCurrentVal = .Fields(strFieldName)
                End If
                
                .MoveNext
            Loop
            
            ' Return maximum value found
            DMax = vntCurrentVal
        Else
            DMax = 0
        End If
        
        .Close
    End With
    
DMax_Exit:
    Exit Function
    
Error_DMax:

    ' No criteria specified
    If Err <> 3077 Then
        
        'Display the error and get out
        MsgBox "Error (" & Err & "): " & Error(Err) & " in DMax", _
           vbCritical, APP_NAME
        
        Resume DMax_Exit:
    Else
       Resume Next
    End If
End Function

Function DMin(ByVal strFieldName As String, ByVal strRecSource As String, _
    ByVal strCriteria As String) As Long
' DMin(expr, domain , criteria)
' Esample: vntReturnVal = DMin("Title", "Titles", "Au_ID = " & _
'          Format(data1.Recordset("Au_ID")))
'
'   Argument Description
'   ----------------------------------------------------------------
'   expr       String expression identifying the field that contains
'              the data you want to return. Operands in expr can
'              include the name of a table field.
'
'   domain     String expression identifying the records that
'              constitute the record set. It can be a table name,
'              query name, or SQL expression that returns data.
'
'   criteria   Optional string expression used to restrict the range
'              of data on which DMax is performed. For example,
'              criteria could be the SQL expression's WHERE clause
'              without the word WHERE. If criteria is omitted, DMax
'              evaluates expr against the entire record set.
    Dim dsResult As Recordset
    Dim vntCurrentVal As Variant

On Local Error GoTo Error_DMin:

    'Create a dynaset based on the record source or SQL string provided
    Set dsResult = pdbs.OpenRecordset(strRecSource, dbOpenDynaset)
    
    With dsResult

        'Find first record that meets criteria provided
        .FindFirst strCriteria
        
        'See if we found any records
        If Not .NoMatch Then
        
            ' Set variable vntCurrentVal
            vntCurrentVal = .Fields(strFieldName)
            
            Do While Not .EOF
                ' Cycle through each value from the row to find the largest
                If .Fields(strFieldName) < vntCurrentVal Then
                   vntCurrentVal = .Fields(strFieldName)
                End If
                
                .MoveNext
            Loop
            
            ' Return the maximum value found
            DMin = vntCurrentVal
        Else
            DMin = 0
        End If
        .Close
    End With

DMin_Exit:
    Exit Function
    
Error_DMin:

    ' No criteria specified
    If Err <> 3077 Then
        'Display the error and get out
        MsgBox "Error (" & Err & "): " & Error(Err) & " in DMax", _
           vbCritical, APP_NAME
        
        Resume DMin_Exit:
    Else
       Resume Next
    End If
    
End Function

Function DFirst(ByVal FieldName As String, ByVal RecSource As String, _
   ByVal strCriteria As String) As Variant

' DFirst(expr, domain, expr)
'
'   Argument Description
'   ----------------------------------------------------------------
'   expr       String expression identifying the field that contains
'              the first record you want to return. Operands in expr
'              can include the name of a table field.
'
'   domain     String expression identifying the records that
'              constitute the record set. It can be a table name,
'              query name, or SQL expression that returns data.
'
'   criteria   Optional string expression used to restrict the range
'              of data on which DFirst is performed. For example,
'              criteria could be the SQL expression's WHERE clause
'              without the word WHERE. If criteria is omitted, DFirst
'              evaluates expr against the entire record set.

Dim dsResult As Recordset
Dim ReturnValue As Variant

   On Local Error GoTo Error_DFirst:

   ' Create a dynaset based on the record source or SQL string provided
   Set dsResult = pdbs.OpenRecordset(RecSource, dbOpenDynaset)

   With dsResult
      
        'Find first record that meets criteria provided
        .FindFirst strCriteria
        
        'See if we found any records
        If Not .NoMatch Then
            ' Move to first record
            .MoveFirst
        
            ' Return field value
            DFirst = dsResult(FieldName).Value
        End If
        
        .Close
   End With
   
DFirst_Exit:
   Exit Function

Error_DFirst:

    ' No criteria specified
    If Err <> 3077 Then
        'Display the error and get out
        MsgBox "Error (" & Err & "): " & Error(Err) & " in DFirst()", _
           vbCritical, APP_NAME
      
        Resume DFirst_Exit:
    Else
        Resume Next
    End If
    
End Function

Function DLast(ByVal FieldName As String, ByVal RecSource As String, _
   ByVal strCriteria As String) As Variant

' DLast(expr, domain, expr)
'
'   Argument Description
'   ----------------------------------------------------------------
'   expr       String expression identifying the field that contains
'              the first record you want to return. Operands in expr
'              can include the name of a table field.
'
'   domain     String expression identifying the records that
'              constitute the record set. It can be a table name,
'              query name, or SQL expression that returns data.
'
'   criteria   Optional string expression used to restrict the range
'              of data on which DLast is performed. For example,
'              criteria could be the SQL expression's WHERE clause
'              without the word WHERE. If criteria is omitted, DLast
'              evaluates expr against the entire record set.

Dim dsResult As Recordset
Dim ReturnValue As Variant

   On Local Error GoTo Error_DLast:

   ' Create a dynaset based on the record source or SQL string provided
   Set dsResult = pdbs.OpenRecordset(RecSource, dbOpenDynaset)

   With dsResult
      
        'Find last record that meets criteria provided
        .FindLast strCriteria
        
        'See if we found any records
        If Not .NoMatch Then
            ' Move to last record
            .MoveLast
        
            ' Return field value
            DLast = dsResult(FieldName).Value
        End If
        .Close
   End With
   
DLast_Exit:
   Exit Function

Error_DLast:

    ' No criteria specified
    If Err <> 3077 Then
        'Display the error and get out
        MsgBox "Error (" & Err & "): " & Error(Err) & " in DLast()", _
           vbCritical, APP_NAME
   
        Resume DLast_Exit:
    Else
        Resume Next
    End If
    
End Function

Function DCount(strFieldName As String, strDomainName As String, _
   strCriteria As String) As Long
   
'---------------------------------------------------
' Use DCount to return a count
'   of records when the domain is a query based on a
'   totals/aggregate query on an attached SQL table.
'---------------------------------------------------

Dim rst As Recordset

    If VarType(strFieldName) <> 8 Or Len(strFieldName) = 0 Then
        MsgBox "You Must Specify a Field name", , "DCount"
        
        Exit Function
    End If
    
    If VarType(strDomainName) <> 8 Or Len(strDomainName) = 0 Then
        MsgBox "You Must Specify a Domain name", , "DCount"
        
        Exit Function
    End If
    
    If VarType(strCriteria) <> 8 And Not IsNull(strCriteria) Then
        MsgBox "Invalid strCriteria", , "DCount"
        
        Exit Function
    End If
    
    Set rst = pdbs.OpenRecordset(strDomainName)
    
    If strFieldName <> "*" Then
        If Len(strCriteria) > 0 Then
            strCriteria = "Select * From " & strDomainName & " Where " & _
                strCriteria & " AND "
        End If
        
        strCriteria = strCriteria & "[" & strFieldName & "] Is Not Null"
            
        rst.Close
            
        Set rst = pdbs.OpenRecordset(strCriteria)
    End If
    
    With rst
        If .EOF Then
            DCount = 0
        Else
            .MoveLast
            DCount = .RecordCount
        End If
            
        .Close
    End With
    
End Function

Function DFix(ByVal strCriteria, intDQuote As Integer)
'------------------------------------------------------------------
' Fixes string arguments passed to Criteria in domain functions
'
' intDQuote should be TRUE or -1 if Double Quotes (") delimit Criteria
' intDQuote should be FALSE or 0 if Single Quotes (') delimit Criteria
'
' e.g. this gives an error
'   (note the quote (') in the data)
'   X="Mike's Diner"
'   A=DCount("*","Clients","Name='" & X & "'")
'
' Use either:
'   X=DFix("Mike's Diner",False)
' Or:
'   A=DCount("*","Clients","Name='" & DFix(X,False) & "'")
'------------------------------------------------------------------

Dim intQuotePos As Integer
Dim intOldQuotePos As Integer
Dim strQuote As String * 1
    
    If VarType(strCriteria) = 8 Then
        If intDQuote = 0 Then
            strQuote = "'"
        Else
            strQuote = """"
        End If
        
        intQuotePos = InStr(strCriteria, strQuote)
        
        Do While intQuotePos > 0
            intOldQuotePos = intQuotePos + 2
            strCriteria = Left$(strCriteria, intQuotePos) & strQuote & _
               Mid$(strCriteria, intQuotePos + 1)
               
            intQuotePos = InStr(intOldQuotePos, strCriteria, strQuote)
        Loop
    End If
    
    DFix = strCriteria
    
End Function