Einleitung

Ein gern benutzter Befehl in VBA ist DLOOKUP - eine einfache Methode, um auf Datenbankinhalte zuzugreifen. Man erspart sich die Syntax eines SQL-Statements, den Umgang mit Recordsets - und nimmt dafür auch gerne die begrenzte Funktionalität des Befehls in Kauf. Begrenzt insofern, als dass man per DLOOKUP immer nur einen Datensatz aus der durch die Suchkriterien vorgegebenen Ergebnismenge auslesen kann.

Leider gibt es neben dieser funktionalen Einschränkung eine weitere, die man nicht so unmittelbar wahrnimmt: DLOOKUP ist mit Abstand die langsamste Methode, um auf eine Datenbank zuzugreifen. Und gerade wegen seiner Einfachheit wird der Befehl gerne in Schleifen oder in gebundenen Unterformularen - und damit faktisch verschachtelt in einer anderen Abfrage verwendet. Diese Konstellation ist der perfekte performance killer.

Eine Lösung für das Geschwindigkeitsproblem liegt in der Erstellung eines Ersatzfunktion, welche die gleiche Syntax wie DLOOKUP verwendet, aber per DAO auf die Datenbank zugreift. Im Folgenden zeige ich das am Beispiel von Microsoft Access 2003 - es sollte aber identisch mit allen andern Access-Versionen und Office-Produkten funktionieren.

Vorbereitungen

Eigentlich gibt es nicht viel zu tun: Um die geplante Funktion einzusetzen, muss zunächst die Verknüpfung zu Microsoft Data Access Objects im VBA-Projekt hergestellt werden. Das erfolgt im Visual Basic Editor (den man in Microsoft Access am schnellsten über die Tastenkombination <ALT>-<F11> öffnet) über den Menüpunkt Extras -> Verweise.

Anschließend fügt man ein neues Modul zum VBA-Projekt hinzu, in welchem die Funktionen als öffentliche Funktionen zur Verfügung gestellt werden. Natürlich kann man die Funktion auch direkt im Quellcode eines Formulars unterbringen - dann steht die Funktion allerdings nur innerhalb des Formulars bzw. nur dann zur Verfügung, wenn das Formular geladen worden ist. Zuverlässiger ist da sicher die Methode eines eigenen Moduls.

Der erste Befehl innerhalb des Moduls setzt die Such- und Sortierreihenfolge bei Datenbankoperationen auf die Einstellung der Datenbank, der zweite sorgt dafür, dass jede verwendete Variable innerhalb des Moduls vorher deklariert werden muss. Typenreine Programmierung ist zwar bei VBA nicht unbedingt Pflicht und auch in diesem Beispiel nicht konsequent durchgehalten - aber zumindest sollten alle Variablen irgendwann einmal deklariert werden.

Option Compare Database
Option Explicit

Ersatz für DLOOKUP

Dann folgt auch schon die Deklaration der ersten Funktion. In diesem Fall ist es der Ersatz für die Funktion DLOOKUP. Durch die Deklaration als Public kann die Funktion im gesamten VBA-Projekt als vollwertiger Ersatz für DLOOKUP verwendet werden. Zusätzlich hat die Funktion noch einen weiteren, optionalen Parameter erhalten: Als vierten Parameter kann eine Sortierungsklausel übergeben werden. Damit kann ich zum Beispiel sicherstellen, dass ich den ersten oder letzten Datensatz aus der Ergebnismenge erhalte - und zwar nach einem vom übergebenen Wert völlig unabhängigen Sortierkriterium.

Public Function DAO_Lookup(sExpr As String, sDomain As String, Optional vCriteria, Optional vOrderClause) As Variant
Dim rstDAO  As DAO.Recordset
Dim sSQL    As String

On Error GoTo Mark_Error

    If sExpr <> "" And sDomain <> "" Then
        ' SQL-String zusammensetzen
        sSQL = "SELECT TOP 1 " & sExpr & " FROM " & sDomain
        If Not IsMissing(vCriteria) And Not IsNull(vCriteria) Then
            sSQL = sSQL & " WHERE " & vCriteria
        End If
        If Not IsMissing(vOrderClause) And Not IsNull(vOrderClause) Then
            sSQL = sSQL & " ORDER BY " & vOrderClause
        End If
        sSQL = sSQL & ";"
    
        ' Abfrage ausführen
        Set rstDAO = CurrentDb.OpenRecordset(sSQL, dbOpenForwardOnly)
        If rstDAO.RecordCount = 0 Then
            DAO_Lookup = Null
        Else
            DAO_Lookup = rstDAO(0)
        End If
        rstDAO.Close
    Else
        DAO_Lookup = Null
    End If
    
Mark_Exit:
    Set rstDAO = Nothing
    Exit Function
Mark_Error:
    Resume Mark_Exit
End Function

Die Funktion selbst bietet wenig Aufregendes. Worauf man beim Arbeiten mit Recordsets stets achten sollte ist, dass sie nach der letzten Verwendung mit der Methode Close geschlossen werden sollten und am Ende der Funktion die entsprechende Objektvariable freigegeben werden sollte. Das macht es der Garbage-Collection von VBA leichter, nicht mehr verwendeten Speicherplatz freizugeben.

Ersatz für DMIN

Nach dem gleichen Strickmuster lassen sich nun auch Ersatzfunktionen für DMAX, DMIN und DCOUNT erzeugen. Zunächst der Quellcode für die Funktion DMIN:

Public Function DAO_Min(sExpr As String, sDomain As String, Optional vCriteria As Variant) As Variant
Dim rstDAO  As DAO.Recordset
Dim sSQL    As String

On Error GoTo Mark_Error

    If sExpr <> "" And sDomain <> "" Then
        ' SQL-String zusammensetzen
        sSQL = "SELECT TOP 1 " & sExpr & " FROM " & sDomain
        If Not IsMissing(vCriteria) Then
            sSQL = sSQL & " WHERE " & vCriteria
        End If
        sSQL = sSQL & " ORDER BY " & sExpr & " ASC;"
    
        ' Abfrage ausführen
        Set rstDAO = CurrentDb.OpenRecordset(sSQL, dbOpenForwardOnly)
        If rstDAO.RecordCount = 0 Then
            DAO_Min = Null
        Else
            DAO_Min = rstDAO(0)
        End If
        rstDAO.Close
    Else
        DAO_Min = Null
    End If
    
Mark_Exit:
    Set rstDAO = Nothing
    Exit Function
Mark_Error:
    Resume Mark_Exit
End Function

Ersatz für DMAX

Und hier folgt der Quellcode für die Ersatzfunktion für DMAX. Der einzige Unterschied zu DMIN liegt hier in der umgekehrten Sortierreihenfolge innerhalb des SQL-Statements.

Public Function DAO_Max(sExpr As String, sDomain As String, Optional vCriteria As Variant) As Variant
Dim rstDAO  As DAO.Recordset
Dim sSQL    As String

On Error GoTo Mark_Error

    If sExpr <> "" And sDomain <> "" Then
        ' SQL-String zusammensetzen
        sSQL = "SELECT TOP 1 " & sExpr & " FROM " & sDomain
        If Not IsMissing(vCriteria) Then
            sSQL = sSQL & " WHERE " & vCriteria
        End If
        sSQL = sSQL & " ORDER BY " & sExpr & " DESC;"
    
        ' Abfrage ausführen
        Set rstDAO = CurrentDb.OpenRecordset(sSQL, dbOpenForwardOnly)
        If rstDAO.RecordCount = 0 Then
            DAO_Max = Null
        Else
            DAO_Max = rstDAO(0)
        End If
        rstDAO.Close
    Else
        DAO_Max = Null
    End If
    
Mark_Exit:
    Set rstDAO = Nothing
    Exit Function
Mark_Error:
    Resume Mark_Exit
End Function

Ersatz für DCOUNT

Für die Funktion DCOUNT greife ich auf einen Befehl zurück, der Bestandteil des DAO-Befehlssatzes (und eigentlich Standardbestandteil fast aller gängigen SQL-Dialekte ist. Das SQL-Statement COUNT(*) zählt alle Datensätze der Ergebnismenge und liefert das Ergebnis als Zahlenwert zurück. Enthält die Ergebnismenge keine Treffer, wird die Zahl 0 zurückgeliefert - nicht zu verwechseln mit dem Datenbankwert NULL, der einer leeren Menge entspricht.

Public Function DAO_Count(sExpr As String, sDomain As String, Optional vCriteria As Variant) As Variant
Dim rstDAO  As DAO.Recordset
Dim sSQL    As String

On Error GoTo Mark_Error

    If sExpr <> "" And sDomain <> "" Then
        ' SQL-String zusammensetzen
        sSQL = "SELECT COUNT(" & sExpr & ") AS CountResult FROM " & sDomain
        If Not IsMissing(vCriteria) Then
            sSQL = sSQL & " WHERE " & vCriteria
        End If
        sSQL = sSQL & ";"
    
        ' Abfrage ausführen
        Set rstDAO = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
        If rstDAO.RecordCount = 0 Then
            DAO_Count = Null
        Else
            DAO_Count = rstDAO(0)
        End If
        rstDAO.Close
    Else
        DAO_Count = Null
    End If
    
Mark_Exit:
    Set rstDAO = Nothing
    Exit Function
Mark_Error:
    Resume Mark_Exit
End Function

Mehrere Datensätze aus der Ergebnismenge auslesen

Zum Schluss noch eine Funktion, die insbesondere für Ausgabezwecke ganz interessant sein kann. Manchmal wäre es schön, wenn DLOOKUP nicht nur den ersten Datensatz der Ergebnismenge liefern würde, sondern alle - idealerweise getrennt durch ein definierbares Trennzeichen wie einen Zeilenumbruch oder ein Semikolon. Genau das erledigt die folgende Funktion DAO_MultiLookup:

Public Function DAO_MultiLookup(sExpr As String, sDomain As String, Optional vCriteria As Variant, Optional sOrderClause As String, Optional sChar As String)
Dim rstDAO  As DAO.Recordset
Dim sSQL    As String

On Error GoTo Mark_Error

    DAO_MultiLookup = Null
    ' Trennzeichen initialisieren
    If sChar = "" Then
        sChar = vbCrLf
    End If
    If sExpr <> "" And sDomain <> "" Then
        ' SQL-String zusammensetzen
        sSQL = "SELECT " & sExpr & " FROM " & sDomain
        If Not IsMissing(vCriteria) Then
            sSQL = sSQL & " WHERE " & vCriteria
        End If
        If sOrderClause <> "" Then
            sSQL = sSQL & " ORDER BY " & sOrderClause
        End If
        sSQL = sSQL & ";"
        ' Abfrage ausführen
        Set rstDAO = CurrentDb.OpenRecordset(sSQL, dbOpenForwardOnly)
        ' Ergebnis durchlaufen
        Do While Not rstDAO.EOF
            DAO_MultiLookup = DAO_MultiLookup & rstDAO(0)
            rstDAO.MoveNext
            If Not rstDAO.EOF Then DAO_MultiLookup = DAO_MultiLookup & sChar
        Loop
        rstDAO.Close
    Else
        DAO_MultiLookup = Null
    End If

Mark_Exit:
    Set rstDAO = Nothing
    Exit Function
Mark_Error:
    Resume Mark_Exit
End Function

Was in allen hier vorgestellten Funktionen noch fehlt ist eine Fehlerbehandlung im Mark_Error-Zweig der Funktionen. Hier könnte zum Beispiel auch bei unvorhergesehenen Fehlern der Aufruf der originalen DLOOKUP, DMIN, DMAX oder DCOUNT-Funktion stehen. Damit wäre eine maximale Kompatibilität zur Originalfunktion gewährleistet.