Comments (0)

Hallo,
über 4 Jahre Pause mit Access Bloggen – doch heute kommt wieder mal ein erstes Lebenszeichen von mir 😉
Es geht um Domänenfunktionen die eigentlich jeder kennt, wie z.B. Dlookup() oder DCount(). Da diese – zumindest in den Access-Versionen bis 2010 welche ich verwende – wenig performant in bezug auf Geschwindigkeit sind gibt es auch seit vielen Jahren Ersatzfunktionen. Ich selbst verwende immer wieder eine Version die mal von Sascha Trowitzsch (siehe MS-Office-Forum.net) erstellt wurde.
Diese liefert genau 1 Diskreten Wert zurück.
Oftmals braucht man aber nicht einer sondern mehrere Feldwerte eines Datensatzes – daher habe ich die Funktion etwas umgestrickt – ich nenne sie jetzt mal DSLookup(), und das sieht dann so aus:

Public Function DSLookup(ByVal Expression As String, ByVal Domain As String, Optional ByVal Criteria As String) As Variant
    Dim strSQL As String
    Dim retArr As Variant
    Dim ExpressionCounter As Long
    Dim i As Long

    ExpressionCounter = UBound(Split(Trim(Expression), ","))
    strSQL = "SELECT " & Expression & " FROM " & Domain
    If Not Criteria = vbNullString Then strSQL = strSQL & " WHERE " & Criteria

    If ExpressionCounter = 0 Then
        DSLookup = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
    Else
        ReDim retArr(ExpressionCounter)
        With DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
            For i = 0 To ExpressionCounter
                retArr(i) = .Fields(i)
            Next i
        End With
        DSLookup = retArr
    End If
End Function

Die Parameter sollten selbsterklärend sein, sind die selben wie bei der Eingebauten DLookup() Funktion.
Der Rückgabewert ist jetzt vom Typ Variant, d.H. es können einzelne Werte als auch ganze Arrays zurückgegeben werden.

Der Beginn ist noch ziemlich einfach gehalten, es wird ein Abfragestring in der Variable strSQL gebildet, und je nach dem ob der optionale Parameter „Criteria“ angegeben wurde wird auch eine Where-Klausel angehängt mit diesem Parameter.
Je nach dem ob in Expression ein einzelnes Tabellenfeld oder eine Kommaliste an Tabellenfeldern steht wird danach unterschieden. ExpressionCounter ermittelt über die Split()-Funktion die Anzahl der Tabellenfelder.
Bei einem einzelnen Feld ist der Wert 0, und es wird die Methode OpenRecordset auf das Datenbankobjekt mit der entsprechenden Abfrage angewendet. Die (0) am Ende liefert genau den ersten gefundenen Eintrag. Fragt jetzt nicht warum ich DBEngine(0)(0) und nicht CurrentDB verwende, ersteres soll(te) bei bestimmten Datenbankabläufen schneller sein. Wer das genauer wissen möchte kann hier mal nachlesen: https://www.access-programmers.co.uk/../
Falls mehrere Tabellenfelder im Parameter „Expression“ stehen, wird zuerst das Rückgabe-Array Dimensioniert und in einer For/Next Schleife dieses mit Werten belegt.

Das wars auch schon.
Der Aufruf ist auch ziemlich simple wie nachfolgendes Beispiel zeigt:

Private Sub GetUsername()
    Dim Userdata As Variant
    Userdata = DSLookup("Vorname, Nachname", "dbo_User", "ID=21")
    MsgBox Userdata(0) & " " & Userdata(1)
End Sub

Aus der Tabelle dbo_User wird der Vorname und Nachname des Users mit ID 21 in das Array Userdata geschrieben und ausgegeben.

Alternativen und verschiedene Spielarten gibts natürlich auch noch. Z.B. könnte man ein leeres fertig Dimensioniertes Array ByRef an die Prozedur übergeben. Es wird dann aber vom Entwickler auch Selbstdisziplin verlangt – weil die Prozedur verlangt dann auch je nach Dimensionierung die korrekte Anzahl an Feldern im Recordsetobjekt. Aber wenn man bei klarem Kopf während des Entwickelns ist kann man sowas schon mal machen. Die Prozedur verkürzt sich dadurch stark auf fast die Hälfte:

Public Sub DSLookup(ByVal Expression As String, ByVal Domain As String, ByVal Criteria As String, ByRef retArr As Variant)
    Dim strSQL As String
    Dim i As Long

    strSQL = "SELECT " & Expression & " FROM " & Domain
    If Not Criteria = vbNullString Then strSQL = strSQL & " WHERE " & Criteria

    With DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
        For i = 0 To UBound(retArr)
            retArr(i) = .Fields(i)
        Next i
    End With
End Sub

Der Aufruf ist jetzt ein klein wenig anderst, und zwar ist der Rückgabewert über das Array jetzt zwingend ein Array, und dieses muss auch dimensioniert sein zumindest der 0 für 1 Element. Und auch bei der Ausgabe/Weitergabe ist zu beachten dass auch nur bei einem einzelnen Tabellenfeld jetzt ein Array angesprochen werden muss mit dem ID 0.

Private Sub GetUsername()
    Dim Userdata(0) As Variant
    DSLookup "Vorname", "dbo_User", "ID=21", Userdata
    MsgBox Userdata(0)
End Sub

So, das wars jetzt aber erstmal für Heute, es wird sicherlich nicht weitere 4 Jahre dauern bis ihr was von mir hört.

Bis dahin
©2020 Andreas Vogt