Tipp 4.1 - DAO-DOM Funktionen

Wie kann ich die verschiedenen DOM Funktionen innerhalb einer Prozedur simulieren (DAO)?

Mit dieser Funktion können Sie die verschiedenen Domänenaggregat Funktionen unter DAO innerhalb einer Prozedur simulieren. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

ab Access 2000Hinweis: Durch spezielle Anweisungen können Sie diese Funktion erst ab Access 2000 einsetzen.

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 A2XDaoDomain( _
       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 DAO (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  | ?A2XDaoDomain(dtSum,"Einzelpreis", _
   '//           |               "Artikel")
  '//           | ?A2XDaoDomain(dtSum,"Einzelpreis", _
   '//           |               "Artikel",, _
   '//           |               "Auslaufartikel=True")
  '// =====================================================
  On Error GoTo HandleErr
  ' Verweis auf DAO 3.6 Object Library muss gesetzt sein!
  Dim dbs As DAO.Database
  Dim rst As DAO.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 dbs = DAO.DBEngine.Workspaces(0).OpenDatabase(psDbs)
  Else
    Set dbs = CurrentDb
  End If
 
  ' Recordset öffnen
  Set rst = dbs.OpenRecordset(sSql)
 
  ' Falls DS vorhanden, Wert übergeben
  If rst.RecordCount > 0 Then
    vRet = rst![SummaryValue]
  End If
 
  If Not IsNull(vRet) Then
    A2XDaoDomain = vRet
  End If
 
HandleExit:
  On Error Resume Next
  If Not rst Is Nothing Then rst.Close: Set rst = Nothing
  If Not dbs Is Nothing Then dbs.Close: Set dbs = Nothing
  Exit Function
 
HandleErr:
  Select Case Err.Number
  Case Else
    MsgBox "Fehler " & Err.Number & ": " & _
           Err.Description, vbCritical, _
           "basDao.A2XDaoDomain"
  End Select
  Resume HandleExit
End Function