6.6 Ersatz für Domänenaggregat-Funktionen
Die sehr einfach einzusetzenden Domänenaggregat-Funktionen wie z.B. DLookup(), DCount(), DSum() o.ä. haben den entscheidenden Nachteil, dass Indizes eher ungünstig eingesetzt werden. D.h., dass die Wertermittlung bei umfangreichen Tabellen länger als nötig dauern kann. Die 3 folgenden beispielhaften Ersatzfunktionen (DAvg() usw. könnten ähnlich umgesetzt werden) werden in derselben Art eingesetzt und nutzen Indizes, sofern diese in der Tabelle vorhanden sind und Kriterien benötigt werden. Außerdem werden im Fehlerfall etwas genauere Ausgaben generiert (statt z.B. nur #Fehler im Steuerelementinhalt):
Public Function TLookup(Expression As String, Domain As String, _ Optional Criteria) As Variant 'Ersatz für DLookup() On Error GoTo TLookup_Err Dim strSQL As String strSQL = "SELECT " & Expression & " FROM " & Domain If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria TLookup = DBEngine(0)(0).OpenRecordset(strSQL, 8)(0) Exit Function TLookup_Err: Select Case Err.Number Case 3021 'kein Datensatz gefunden TLookup = Null Case 3061 'einer der Feldnamen (Ausdruck oder Kriterium) stimmt nicht TLookup = "#Ausdruck/Kriterium" Case 3078 'Name der Tabelle oder Abfrage stimmt nicht TLookup = "#Domäne" Case 3464 'Datentyp im Kriterium ist falsch TLookup = "#Kriterium" Case Else 'Sonstige Fehler TLookup = "#Fehler" End Select End Function
Public Function TCount(Expression As String, Domain As String, _ Optional Criteria) As Variant 'Ersatz für DCount() On Error GoTo TCount_Err Dim strSQL As String strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria TCount = DBEngine(0)(0).OpenRecordset(strSQL, 8)(0) Exit Function TCount_Err: Select Case Err.Number Case 3061 'einer der Feldnamen (Ausdruck oder Kriterium) stimmt nicht TCount = "#Ausdruck/Kriterium" Case 3078 'Name der Tabelle oder Abfrage stimmt nicht TCount = "#Domäne" Case 3464 'Datentyp im Kriterium ist falsch TCount = "#Kriterium" Case Else 'Sonstige Fehler TCount = "#Fehler" End Select End Function
Public Function TSum(Expression As String, Domain As String, _ Optional Criteria) As Variant 'Ersatz für DSum() On Error GoTo TSum_Err Dim strSQL As String strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria TSum = DBEngine(0)(0).OpenRecordset(strSQL, 8)(0) Exit Function TSum_Err: Select Case Err.Number Case 3061 'einer der Feldnamen (Ausdruck oder Kriterium) stimmt nicht TSum = "#Ausdruck/Kriterium" Case 3075 'Summierender Ausdruck ist falsch (z.B. "*" ist n. mgl.) TSum = "#Ausdruck" Case 3078 'Name der Tabelle oder Abfrage stimmt nicht TSum = "#Domäne" Case 3464 'Datentyp im Kriterium ist falsch TSum = "#Kriterium" Case Else 'Sonstige Fehler TSum = "#Fehler" End Select End Function
