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.
Hinweis: 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