By
Hondo, 11. Januar 2020
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
Comments (0) 
