Beispiel:

Option Explicit
 
Public Enum eDomainType
  dtAvg = 0                  ' Mittelwert
  dtCount = 1                ' Anzahl
  dtFirst = 2                ' Erster DS
  dtLast = 3                 ' Letzter DS
  dtMax = 4                  ' Höchster Wert
  dtMin = 5                  ' Niedrigster Wert
  dtLookup = 6               ' Wert allgemein
  dtSdtev = 7                ' Standardabweichung
  dtSum = 8                  ' Summe
  dtVar = 9                  ' Varianz
End Enum
 
Public Function A2XADODomain( _
                             peType As eDomainType, _
                             psField As String, _
                             psDomain As String, _
                             Optional psDbs _
                             As String = vbNullString, _
                             Optional psCriteria _
                             As String = vbNullString) _
       As Variant
  '// =====================================================
  '// Methode   | Simuliert die Domänenaggregatfunktionen
  '//           | unter ADO (performanter)
  '// -----------------------------------------------------
  '// Parameter | peType     - Funktionstyp
  '//           | psField    - Tabellen-/Abfragefeld
  '//           | psDomain   - Tabelle/Abfrage
  '//           | psDbs      - Optional Pfad & Name der DB
  '//           | psCriteria - Optional Kriterium
  '//           | Hinweis    - Das Enum eDomainType sollte
  '//           |              vorab auf Modulebene
  '//           |              deklariert sein!
  '// -----------------------------------------------------
  '// Rückgabe  | Variant - Wert bzw. NULL falls kein DS
  '//           |           vorhanden
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel  | ?A2XADODomain(dtSum,"Einzelpreis", _
  '//           |               "Artikel")
  '//           | ?A2XADODomain(dtSum,"Einzelpreis", _
  '//           |               "Artikel",, _
  '//           |               "Auslaufartikel=True")
  '// =====================================================
  On Error GoTo HandleErr
  ' Verweis auf ActiveX Data Object 2.X muss gesetzt sein!
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
 
  Dim sSql As String
  Dim vRet As Variant
  Dim sDomType As String
 
  'Domänenaggregatfunktionen ermitteln
  Select Case peType
    Case dtAvg
      sDomType = "Avg"
    Case dtCount
      sDomType = "Count"
    Case dtFirst
      sDomType = "First"
    Case dtLast
      sDomType = "Last"
    Case dtMax
      sDomType = "Max"
    Case dtMin
      sDomType = "Min"
    Case dtLookup
      sDomType = vbNullString
    Case dtSdtev
      sDomType = "Sdtev"
    Case dtSum
      sDomType = "Sum"
    Case dtVar
      sDomType = "Var"
  End Select
 
  ' Rückgabewert initialisieren
  vRet = Null
 
  ' SQL-String zusammen schnipseln
  sSql = "SELECT "
  If Len(sDomType) > 0 Then
    sSql = sSql & sDomType
  End If
  sSql = sSql & "([" & psField & "]) AS SummaryValue "
  sSql = sSql & "FROM [" & psDomain & "]"
 
  ' Falls Kriterium angegeben, WHERE-Klausel erstellen
  If Len(psCriteria) > 0 Then
    sSql = sSql & "WHERE " & psCriteria
  End If
  sSql = sSql & ";"
 
  ' Datenbank öffnen
  If Len(psDbs) > 0 Then
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=" & psDbs
  Else
    Set cnn = CurrentProject.Connection
  End If
 
  ' Recordset öffnen
  Set rst = New ADODB.Recordset
  rst.Open sSql, cnn, adOpenStatic
 
  ' Falls DS vorhanden, Wert übergeben
  If rst.RecordCount > 0 Then
    vRet = rst![SummaryValue]
  End If
 
  If Not IsNull(vRet) Then
    A2XADODomain = vRet
  End If
 
HandleExit:
  On Error Resume Next
  If Not rst Is Nothing Then rst.Close: Set rst = Nothing
  If Not cnn Is Nothing Then cnn.Close: Set cnn = Nothing
  Exit Function
 
HandleErr:
  Select Case Err.Number
    Case Else
      MsgBox "Fehler " & Err.Number & ": " & _
             Err.Description, vbCritical, _
             "basAdo.A2XADODomain"
  End Select
  Resume HandleExit
End Function