Filtern und Sortieren von Formularen mit Recordset

Im ersten Teil dieser Beitragsreihe („Detailformular und Datenblatt mit ADODB-Recordset“, www.access-im-unternehmen.de/1601) haben wir gezeigt, wie man ein Formular per VBA-Code an ein ADODB-Recordset bindet. Dabei sind wir auf ein grundlegendes Problem gestoßen: Die eingebauten Sortier- und Filterfunktionen von Access – sowohl im Ribbon als auch im Dropdown-Menü des Datenblatt-Spaltenkopfes – funktionieren bei ADODB-gebundenen Formularen nicht. In diesem Beitrag zeigen wir, wie wir diese Funktionen mit eigenen Mitteln vollständig nachbauen.

Das Problem: Warum funktioniert die eingebaute Filterung nicht?

Wenn Access ein Formular filtert oder sortiert, greift es intern auf die Datensatzquelle des Formulars zu – also auf die Tabelle oder Abfrage, die in der gleichnamigen Eigenschaft eingetragen ist.

Bei einem ADODB-gebundenen Formular ist diese Eigenschaft leer, denn wir haben die Datensatzquelle bewusst nicht eingetragen und das Recordset stattdessen per VBA gesetzt.

Access findet also keine SQL-Datensatzquelle und quittiert den Versuch zu filtern mit der Fehlermeldung Geben Sie einen gültigen Wert ein oder Der Datenprovider konnte nicht initialisiert werden.

Die Lösung ist konsequent: Wir übernehmen die Kontrolle über Filterung und Sortierung vollständig selbst. Anstatt Access die SQL-Abfrage manipulieren zu lassen, bauen wir den SQL-String in unserem VBA-Code zusammen und laden das Recordset neu.

Das hat den zusätzlichen Vorteil, dass die Lösung ohne Änderung auch beim Wechsel auf einen SQL Server funktioniert.

Zwei Wege für Sortierung und Filterung

Im Datenblatt gibt es zwei Möglichkeiten, wie der Benutzer sortieren und filtern kann.

Erstens über das Ribbon – die Gruppe Sortieren und Filtern im Tab Start (siehe Bild 1).

Bild 1: Die Anreden werden nicht mehr angezeigt.

Zweitens über das Dropdown-Menü im Spaltenkopf des Datenblatts, das erscheint wenn man mit der Maus über den Spaltenkopf fährt und auf den kleinen Pfeil klickt (siehe Bild 2).

Bild 2: Weitere Filtermöglichkeiten in der Datenblattansicht

Für das Ribbon verwenden wir eine angepasste Ribbon-Definition in der Tabelle USysRibbons, mit der wir die eingebaute Gruppe ausblenden und durch eine eigene ersetzen. Dort haben wir volle Kontrolle über jeden Button und jeden Callback. Das Dropdown-Menü im Spaltenkopf hingegen ist ein eingebauter Access-Mechanismus, den wir nicht direkt ersetzen können. Wir können ihn aber über das Ereignis Bei Filter anwenden (Form_ApplyFilter) abfangen. Access ruft dieses Ereignis auf, bevor es versucht, den Filter anzuwenden – und gibt uns damit die Möglichkeit, die Aktion selbst zu übernehmen.

Eine Information vorneweg: Die Filter unter Textfilter, also zum Beispiel Gleich…, konnten wir nicht technisch sauber abfangen, daher sind diese in Zusammenhang mit Recordsets in Formularen nicht wie gewohnt nutzbar.

Den SQL-Zustand im Modul halten

Die Grundidee unserer Lösung ist einfach: Wir halten den aktuellen SQL-String des Formulars in öffentlichen Variablen im Modul mdlADODB vor. So haben sowohl das Formularmodul als auch die Ribbon-Callbacks jederzeit Zugriff auf den aktuellen Stand:

'SQL-Zustand des aktiven Formulars
Public strBaseSQL As String
Public strLastSQL As String
Public strPendingSQL As String

strBaseSQL enthält den Basis-SQL-String ohne WHERE und ORDER BY – also zum Beispiel „SELECT * FROM tblKunden“.

Dieser wird einmalig in Form_Open gesetzt und ändert sich nie. strLastSQL enthält den zuletzt ausgeführten SQL-String inklusive aller aktiven Filter und Sortierungen. strPendingSQL ist ein Zwischenspeicher, den wir im Timer-Trick benötigen – dazu gleich mehr.

Hilfsfunktionen für SQL-String-Manipulation

Um WHERE– und ORDER BY-Teile aus einem SQL-String zu extrahieren, haben wir zwei Hilfsfunktionen in mdlADODB angelegt.

Diese werden per VBA sowohl von den Ribbon-Callbacks als auch vom Formularmodul aus verwendet (siehe Listing 1).

Public Function GetWhereTeil(strSQL As String) As String
    Dim strBisOrderBy As String
    If InStr(strSQL, " WHERE ") > 0 Then
        strBisOrderBy = strSQL
        If InStr(strBisOrderBy, " ORDER BY ") > 0 Then
            strBisOrderBy = Left(strBisOrderBy, InStr(strBisOrderBy, " ORDER BY ") - 1)
        End If
        GetWhereTeil = Mid(strBisOrderBy, InStr(strBisOrderBy, " WHERE ") + 7)
    End If
End Function
Public Function GetOrderByTeil(strSQL As String) As String
    If InStr(strSQL, " ORDER BY ") > 0 Then
        GetOrderByTeil = Mid(strSQL, InStr(strSQL, " ORDER BY ") + 10)
    End If
End Function

Listing 1: Hilfsfunktionen zum Extrahieren von WHERE- und ORDER BY-Teilen

GetWhereTeil gibt den Inhalt der WHERE-Klausel zurück – also den Teil nach dem Schlüsselwort WHERE und vor einem eventuellen ORDER BY. GetOrderByTeil gibt entsprechend den Teil nach ORDER BY zurück. Beide Funktionen geben einen leeren String zurück, wenn der jeweilige Teil nicht vorhanden ist.

Sortierung über das Ribbon

Für die Sortierung über das Ribbon überschreiben wir die eingebauten Ribbon-Commands SortUp und SortDown mit eigenen Callbacks. In der Ribbon-XML-Definition der Tabelle USysRibbons blenden wir zunächst die eingebaute Gruppe GroupSortAndFilter aus und fügen eine eigene Gruppe ein (siehe Listing 2).

<group idMso="GroupSortAndFilter" visible="false"/>
<group id="grpSortierenFiltern" label="Sortieren und Filtern"
       insertAfterMso="GroupClipboard">
  <toggleButton idMso="FiltersMenu" size="large"/>
  <separator id="sep0"/>
  <toggleButton idMso="SortUp" size="normal"/>
  <toggleButton idMso="SortDown" size="normal"/>
  <button id="btnSortierungAufheben" label="Sortierung entfernen"
          imageMso="SortRemoveAllSorts" size="normal"
          onAction="OnAction_SortRemove"/>
  <separator id="sep1"/>
  <menu idMso="SortSelectionMenu" size="large"/>
  <separator id="sep2"/>
  <button id="btnFilterAufheben" label="Filter ein/aus"
          imageMso="FilterToggleFilter" size="large"
          onAction="OnAction_FilterRemove"
          getEnabled="getEnabled"/>
</group>

Listing 2: Ribbon-XML für die eigene Gruppe Sortieren und Filtern

Das Ergebnis sehen wir in Bild 3.

Bild 3: Neuer Sortieren und Filtern-Bereich im Ribbon

Die Callbacks SortUp und SortDown überschreiben wir mit dem commands-Element der Ribbon-XML, das wir vor der ribbon-Sektion einfügen:

<commands>
  <command idMso="SortUp" onAction="OnAction_Toggle"/>
  <command idMso="SortDown" onAction="OnAction_Toggle"/>
  ... weitere Filter-Commands ...
</commands>

Der Callback OnAction_Toggle im Modul mdlRibbons wird aufgerufen, wenn der Benutzer auf Aufsteigend oder Absteigend klickt. Er setzt CancelDefault = True um die eingebaute Aktion zu unterdrücken und ruft dann SortierungAnwenden auf (siehe Listing 3).

Sub OnAction_Toggle(control As IRibbonControl, ByRef pressed As Boolean, ByRef CancelDefault)
    Dim strRichtung As String
    CancelDefault = True
    Select Case control.Id
        Case "SortUp"
            strRichtung = "ASC"
        Case "SortDown"
            strRichtung = "DESC"
    End Select
    SortierungAnwenden Screen.ActiveForm, Screen.ActiveControl.Name, strRichtung
End Sub

Listing 3: Callback OnAction_Toggle für Aufsteigend und Absteigend

Screen.ActiveControl.Name liefert den Namen des Feldes, in dessen Spalte der Benutzer geklickt hat. Dieser wird zusammen mit der Sortierrichtung an SortierungAnwenden übergeben.

Die Funktion SortierungAnwenden

SortierungAnwenden in mdlADODB ist die zentrale Funktion für alle Sortieroperationen. Sie baut aus dem bestehenden SQL-String einen neuen mit der gewünschten Sortierung zusammen und lädt das Recordset neu. Dabei bleibt ein eventuell aktiver Filter erhalten (siehe Listing 4).

Public Sub SortierungAnwenden(frm As Form, strFeld As String, strRichtung As String)
    On Error Resume Next
    strFeld = frm.Controls(strFeld).ControlSource
    On Error GoTo 0
    strLastSQL = SQLMitSortierung(IIf(Len(strLastSQL) > 0, strLastSQL, strBaseSQL), strFeld, strRichtung)
    Set frm.Recordset = GetRecordset(strLastSQL)
    If Not objRibbon_Main Is Nothing Then
        objRibbon_Main.Invalidate
    End If
End Sub

Listing 4: Die Prozedur SortierungAnwenden

Achtung: Bei Nachschlagefeldern wird hier nach dem Wert der gebundenen Spalte sortiert, nicht nach dem angezeigten Wert. Sie ruft SQLMitSortierung auf, die den neuen SQL-String zusammenstellt. Diese Hilfsfunktion extrahiert den WHERE-Teil aus dem bisherigen SQL und hängt die neue Sortierung an (siehe Listing 5).

Public Function SQLMitSortierung(strSQLQuelle As String, strFeld As String, strRichtung As String) As String
    Dim strWhere As String
    strWhere = GetWhereTeil(strSQLQuelle)
    SQLMitSortierung = strBaseSQL
    If Len(strWhere) > 0 Then
        SQLMitSortierung = SQLMitSortierung & " WHERE " & strWhere
    End If
    SQLMitSortierung = SQLMitSortierung & " ORDER BY " & strFeld & " " & strRichtung
End Function

Listing 5: Die Funktion SQLMitSortierung

Wichtig: Wir verwenden immer nur die zuletzt gewählte Sortierung – eine neue Sortierung ersetzt die vorherige komplett.

Eine Mehrfachsortierung über mehrere Felder ist über das Ribbon nicht sinnvoll abbildbar, da der Benutzer keine Rückmeldung erhält, welche Felder gerade sortiert sind. Nach dem Setzen des neuen Recordsets rufen wir objRibbon_Main.Invalidate auf. Das zwingt Access, alle Ribbon-Callbacks neu auszuwerten – insbesondere getEnabled für die Schaltfläche Filter ein/aus, die nur aktiv sein soll wenn ein Filter vorhanden ist.

Sortierung aufheben

Die Schaltfläche Sortierung entfernen ruft den Callback OnAction_SortRemove auf. Dieser prüft, ob überhaupt eine Sortierung aktiv ist und baut dann einen neuen SQL-String ohne ORDER BY zusammen – einen eventuell aktiven Filter behält er dabei (siehe Listing 6).

Sub OnAction_SortRemove(control As IRibbonControl)
    If Len(GetOrderByTeil(strLastSQL)) = 0 Then Exit Sub
    strLastSQL = strBaseSQL & IIf(Len(GetWhereTeil(strLastSQL)) > 0, " WHERE " & GetWhereTeil(strLastSQL), "")
    Set Screen.ActiveForm.Recordset = GetRecordset(strLastSQL)
    If Not objRibbon_Main Is Nothing Then
        objRibbon_Main.Invalidate
    End If
End Sub

Listing 6: Callback OnAction_SortRemove

Filterung über das Auswahl-Menü im Ribbon

Für die Filterung nutzen wir das eingebaute Ribbon-Menü SortSelectionMenu (Auswahl). Dieses zeigt automatisch nur die für den aktuellen Feldtyp passenden Filteroptionen an – bei Textfeldern etwa Enthält und Beginnt mit, bei Datumsfeldern Vor und Nach„. Die einzelnen Commands dieses Menüs überschreiben wir ebenfalls über das commands-Element mit unserem Callback OnAction.

Der Callback OnAction erledigt drei Aufgaben: Er ermittelt das aktive Steuerelement und seinen Wert, quotet den Wert abhängig vom Feldtyp korrekt für SQL und baut den Filterausdruck zusammen.

Werte korrekt für SQL quoten

Je nachdem, ob ein Feld Text, eine Zahl oder ein Datum enthält, muss der Wert im SQL-Filterausdruck unterschiedlich formatiert werden. Bei Textwerten müssen einfache Anführungszeichen gesetzt werden, bei Datumswerten Rauten. Zahlen benötigen kein Trennzeichen. Den Feldtyp lesen wir über frm.Recordset.Fields(strFeld).Type aus dem ADODB-Recordset aus:

'Wert je nach Feldtyp quoten
Select Case lngTyp
    Case 3, 2, 16, 17, 18, 19, 20, 21  'Zahlentypen
        strWert = CStr(varWert)
    Case 7, 133, 134, 135               'Datumstypen
        strWert = "#" & Format(CDate(varWert), _
            "mm\/dd\/yyyy") & "#"
    Case Else                           'Text
        strWert = "'" & Replace(CStr(varWert), _
            "'", "''") & "'"
End Select

Die ADODB-Typkonstanten für Zahlen umfassen unter anderem adInteger (3), adSmallInt (2) und weitere ganzzahlige Typen. Für Datum sind es adDate (7) sowie datumsähnliche Typen. Alle anderen Typen werden als Text behandelt.

Bei Datumswerten ist zu beachten, dass Access den Wert im deutschen Format liefert – also zum Beispiel 23.01.1971. SQL erwartet das Datum jedoch im US-Format mm/dd/yyyy. Wir wandeln den Wert daher zunächst mit CDate in einen echten Datumswert um und formatieren ihn dann mit Format im richtigen Format.

Bei Textwerten ersetzen wir außerdem einfache Anführungszeichen im Wert selbst durch zwei einfache Anführungszeichen – das ist die SQL-Standard-Escape-Sequenz für Hochkommas in Zeichenketten. Ohne diese Maßnahme würde zum Beispiel der Name O’Brien zu einem SQL-Fehler führen.

'SQL-Zustand des aktiven Formulars
Public strBaseSQL As String
Public strLastSQL As String
Public strPendingSQL As String

Public Function GetWhereTeil(strSQL As String) As String
    Dim strBisOrderBy As String
    If InStr(strSQL, " WHERE ") > 0 Then
        strBisOrderBy = strSQL
        If InStr(strBisOrderBy, " ORDER BY ") > 0 Then
            strBisOrderBy = Left(strBisOrderBy, InStr(strBisOrderBy, " ORDER BY ") - 1)
        End If
        GetWhereTeil = Mid(strBisOrderBy, InStr(strBisOrderBy, " WHERE ") + 7)
    End If
End Function
Public Function GetOrderByTeil(strSQL As String) As String
    If InStr(strSQL, " ORDER BY ") > 0 Then
        GetOrderByTeil = Mid(strSQL, InStr(strSQL, " ORDER BY ") + 10)
    End If
End Function

<group idMso="GroupSortAndFilter" visible="false"/>
<group id="grpSortierenFiltern" label="Sortieren und Filtern"
       insertAfterMso="GroupClipboard">
  <toggleButton idMso="FiltersMenu" size="large"/>
  <separator id="sep0"/>
  <toggleButton idMso="SortUp" size="normal"/>
  <toggleButton idMso="SortDown" size="normal"/>
  <button id="btnSortierungAufheben" label="Sortierung entfernen"
          imageMso="SortRemoveAllSorts" size="normal"
          onAction="OnAction_SortRemove"/>
  <separator id="sep1"/>
  <menu idMso="SortSelectionMenu" size="large"/>
  <separator id="sep2"/>
  <button id="btnFilterAufheben" label="Filter ein/aus"
          imageMso="FilterToggleFilter" size="large"
          onAction="OnAction_FilterRemove"
          getEnabled="getEnabled"/>
</group>

<commands>
  <command idMso="SortUp" onAction="OnAction_Toggle"/>
  <command idMso="SortDown" onAction="OnAction_Toggle"/>
  ... weitere Filter-Commands ...
</commands>

Sub OnAction_Toggle(control As IRibbonControl, ByRef pressed As Boolean, ByRef CancelDefault)
    Dim strRichtung As String
    CancelDefault = True
    Select Case control.Id
        Case "SortUp"
            strRichtung = "ASC"
        Case "SortDown"
            strRichtung = "DESC"
    End Select
    SortierungAnwenden Screen.ActiveForm, Screen.ActiveControl.Name, strRichtung
End Sub

Public Sub SortierungAnwenden(frm As Form, strFeld As String, strRichtung As String)
    On Error Resume Next
    strFeld = frm.Controls(strFeld).ControlSource
    On Error GoTo 0
    strLastSQL = SQLMitSortierung(IIf(Len(strLastSQL) > 0, strLastSQL, strBaseSQL), strFeld, strRichtung)
    Set frm.Recordset = GetRecordset(strLastSQL)
    If Not objRibbon_Main Is Nothing Then
        objRibbon_Main.Invalidate
    End If
End Sub

Public Function SQLMitSortierung(strSQLQuelle As String, strFeld As String, strRichtung As String) As String
    Dim strWhere As String
    strWhere = GetWhereTeil(strSQLQuelle)
    SQLMitSortierung = strBaseSQL
    If Len(strWhere) > 0 Then
        SQLMitSortierung = SQLMitSortierung & " WHERE " & strWhere
    End If
    SQLMitSortierung = SQLMitSortierung & " ORDER BY " & strFeld & " " & strRichtung
End Function

Sub OnAction_SortRemove(control As IRibbonControl)
    If Len(GetOrderByTeil(strLastSQL)) = 0 Then Exit Sub
    strLastSQL = strBaseSQL & IIf(Len(GetWhereTeil(strLastSQL)) > 0, " WHERE " & GetWhereTeil(strLastSQL), "")
    Set Screen.ActiveForm.Recordset = GetRecordset(strLastSQL)
    If Not objRibbon_Main Is Nothing Then
        objRibbon_Main.Invalidate
    End If
End Sub

'Wert je nach Feldtyp quoten
Select Case lngTyp
    Case 3, 2, 16, 17, 18, 19, 20, 21  'Zahlentypen
        strWert = CStr(varWert)
    Case 7, 133, 134, 135               'Datumstypen
        strWert = "#" & Format(CDate(varWert), _
            "mm\/dd\/yyyy") & "#"
    Case Else                           'Text
        strWert = "'" & Replace(CStr(varWert), _
            "'", "''") & "'"
End Select

Oder hast Du eine konkrete Frage zu Deiner eigenen Access-Anwendung?

Vielleicht stellt Deine Anwendung Dich vor eine Herausforderung, zu der Du bisher keine Lösung findest. Schlechte Performance, kein ausreichender Zugriffsschutz, Du bist unsicher über Dein Datenmodell oder Dein Code liefert unerklärliche Fehler?

In unserem kostenlosen Access-Audit schaut sich André Minhorst persönlich gemeinsam mit Dir Deine Lösung per Zoom an – und zeigt Dir, wo Datenmodell, VBA-Code, Ergonomie und Sicherheit Optimierungspotenzial bieten.