Volltextsuche mit Fundstellen

Neulich wollte ich mal meine Artikeldatenbank nach bestimmten Suchbegriffen durchforsten. Also habe ich mir eine Abfrage gebaut, die nur die relevanten Felder der zu durchsuchenden Tabelle enthält. Dort dachte ich dann, ich könnte mit der eingebauten Filter-Funktion des Datenblatts schnell zu den gesuchten Fundstellen gelangen. Das Ergebnis war ernüchternd, denn Access lieferte zwar alle passenden Datensätze, aber in den recht langen Texten innerhalb der Datensätze musste ich dann nochmals nach dem gesuchten Text suchen. Das konnte ich nicht auf mir sitzen lassen und habe eine Suchfunktion mit Fundstellen programmiert, die dieser Beitrag vorstellt.

Normalerweise würde man im Datenblatt mit der Maus auf Pfeil nach unten rechts im Spaltenkopf klicken, dann den Menüeintrag Textfilter|Enthält… auswählen, den Suchbegriff eingeben und dann die Suchergebnisse betrachten. Das gelingt auch grundsätzlich, wie Bild 1 zeigt. Aber wie eingangs erwähnt, wird auf diese Weise nicht die Fundstelle markiert.

Filtern nach Suchausdruck

Bild 1: Filtern nach Suchausdruck

Dies erreichen wir etwas besser, wenn wir die Suchen und Ersetzen-Funktion nutzen, die wir über den Ribbon-Eintrag Start|Suchen|Suchen öffnen. Diese springt so zur Fundstelle, dass diese meist ganz unten im sichtbaren Teil des Textes angezeigt wird (s. Bild 2). Auch das ist nur bedingt praxistauglich, da so nur jeweils ein Eintrag gleichzeitig angezeigt wird. Also benötigen wir eine alternative Lösung.

Einsatz der Suchen und Ersetzen-Funktion

Bild 2: Einsatz der Suchen und Ersetzen-Funktion

Ziel

Statt der nicht perfekten Lösung durch die eingebauten Elemente der Access-Datenblattansicht wollen wir eine benutzerdefinierte Lösung entwickeln. Diese soll die Fundstellen ebenfalls in einer Datenblattansicht anzeigen. Allerdings wollen wir auch nur die Fundstelle erhalten und nicht den kompletten Text des durchsuchten Inhalts.

Und der gesuchte Begriff soll farbig hervorgehoben werden, damit wir ihn direkt erkennen! Da wir meist Texte mit mehreren Absätzen haben, wollen wir außerdem einstellen können, wie viele Absätze vor und nach dem Absatz mit dem Suchbegriff ausgegeben werden sollen.

Wir kümmern uns zunächst um die einfache Variante der Prozedur, die nach dem Eingeben eines Suchbegriffs und dem Betätigen der Taste cmdSuchen ausgelöst wird.

Tabelle zum Speichern der Fundstellen

Wenn wir einen oder mehrere längere Texte nach einem Suchbegriff durchsuchen, erhalten wir gegebenenfalls mehrere Suchergebnisse beziehungsweise Fundstellen. Um dem Benutzer diese anzuzeigen, speichern wir sie in einer Tabelle und geben den Inhalt der Tabelle dann in einem Formular aus. Die Tabelle zum Speichern der Fundstellen heißt tblFundstellen und sieht im Entwurf wie in Bild 3 aus. Neben dem Primärschlüsselfeld enthält die Tabelle ein Feld zum Speichern der ID des Beitrags, aus dem die Fundstelle stammt, sowie die Fundstelle selbst.

Tabelle zum Speichern der Fundstellen

Bild 3: Tabelle zum Speichern der Fundstellen

Dabei soll es sich zunächst um die Zeile mit dem gefundenen Begriff und zur zusätzlichen Orientierung noch die vorherige und die folgende Zeile handeln.

Da wir den Suchbegriff selbst in der Fundstelle als Richtext farbig markieren wollen, stellen wir für die Eigenschaft Textformat des Feldes Fundstelle den Wert Rich-Text ein.

Unterformular zur Anzeige der Fundstellen

Die Daten der Tabelle sollen in einem Unterformular namens sfmVolltextsuche ausgegeben werden. Dazu binden wir dieses Unterformular an die Tabelle tblFundstellen und ziehen das Feld Fundstelle aus der Feldliste in den Entwurf dieses Formulars (s. Bild 4).

Entwurf des Unterformulars zur Anzeige der Fundstellen

Bild 4: Entwurf des Unterformulars zur Anzeige der Fundstellen

Da wir in dieses Unterformular weder Daten eingeben noch vorhandene Daten bearbeiten oder löschen wollen, stellen wir die Eigenschaften Anfügen zulassen, Löschen zulassen und Bearbeiten zulassen jeweils auf den Wert Nein ein.

Hauptformular mit der Suchfunktion

Das Hauptformular der Lösung enthält die folgenden Steuer-elemente:

  • Ein Textfeld namens txtSuchbegriff zur Eingabe des Suchbegriffs,
  • eine Schaltfläche namens cmdSuchen, welche die Suche startet,
  • das Unterformular sfmVolltextsuche und
  • das MSForms-Textfeld txtFundstelle.

Die Steuer-elemente werden wie in Bild 5 angeordnet. Damit die Suche nach der Eingabe des Suchbegriffs in das Textfeld txtSuchbegriff sowohl durch das Betätigen der Eingabetaste als auch durch einen Mausklick auf die Schaltfläche cmdSuchen ausgelöst werden kann, stellen wir die Eigenschaft Standard der Schaltfläche cmdSuchen auf Ja ein.

Entwurf des Hauptformulars

Bild 5: Entwurf des Hauptformulars

Damit das Unterformular mit den Suchstellen vergrößert wird, wenn der Benutzer das Hauptformular vergrößert, stellen wir die beiden Eigenschaften Horizontaler Anker und Vertikaler Anker jeweils auf den Wert Beide ein. Damit das Textfeld txtFundstelle nach unten verschoben wird, wenn der Benutzer die Höhe des Formulars vergrößert, stellen wir die Eigenschaft Vertikaler Anker dieses Steuerelements auf den Wert Unten ein.

Zieht der Benutzer das Formular in die Breite, soll auch das Textfeld verbreitert werden, also erhält die Eigenschaft Horizontaler Anker den Wert Beide.

Das Formular soll an die Tabelle mit den zu durchsuchenden Texten gebunden sein, damit sie den kompletten Text zur aktuell im Unterformular markierten Fundstelle schnell anzeigen kann.

Deshalb stellen wir die Eigenschaft Datenherkunft des Formulars auf eine Abfrage namens qryInhalt ein, die wiederum folgenden SQL-Ausdruck enthält und somit nur den Primärschlüsselwert des betroffenen Beitrags sowie seinen vollständigen Text enthält:

SELECT BeitragID, Inhalt, TextRoh
FROM tblBeitraege;

Die MSForms-TextBox binden wir über die Eigenschaft Steuerelementinhalt an das Feld Inhalt dieser Abfrage.

Initialisieren des Formulars

Um das Formular und die Steuer-elemente zu initialisieren, legen wir zwei Ereignisprozeduren an. Die erste soll durch das Ereignis Beim öffnen des Formulars ausgelöst werden und die gegebenenfalls noch vorhandenen Einträge in der Tabelle tblFundstellen löschen.

Diese Prozedur sieht wie folgt aus:

Private Sub Form_Open(Cancel As Integer)
     Dim db As DAO.Database
     Set db = CurrentDb
     db.Execute "DELETE FROM tblFundstellen", dbFailOnError
End Sub

Die zweite Prozedur löst das Ereignis Beim Laden aus. Dort initialisieren wir eine Variable zum Referenzieren der MSForms-TextBox, die wie folgt deklariert wird:

Dim WithEvents objFundstelle As MSForms.TextBox

Die durch das Ereignis Beim Laden ausgelöste Prozedur hat folgenden Code:

Private Sub Form_Load()
     Set objFundstelle = Me!txtFundstelle.Object
     With objFundstelle
         .SelectionMargin = False
         .Font = "Calibri"
         .Font.Size = "9"
         .MultiLine = True
         .BorderStyle = fmBorderStyleSingle
         .SpecialEffect = fmSpecialEffectFlat
         .BorderColor = Me!txtSuchbegriff.BorderColor
         .ScrollBars = fmScrollBarsVertical
     End With
     Set sfm = Me!sfmVolltextsuche.Form
     With sfm
         .OnCurrent = "[Event Procedure]"
     End With
End Sub

Hier stellen wir vor allem die Eigenschaften der MSForms-TextBox txtFundstelle ein (Details siehe Beitrag Die MSForms-TextBox, www.access-im-unternehmen.de/1114). Außerdem referenzieren wir auch noch das Unterformular mit einer Variablen namens sfm. Auch diese soll im Kopf des Klassenmoduls deklariert werden, und zwar wie folgt:

Private WithEvents sfm As Form

Das Schlüsselwort WithEvents verwenden wir, weil wir im Hauptformular auf die Ereignisse des Unterformulars reagieren wollen, in diesem Fall auf das Ereignis Beim Anzeigen. Deshalb stellen wir die Eigenschaft OnCurrent von sfm auf den Wert [Event Procedure] ein. Die passende Ereignisprozedur können wir auch gleich vorstellen:

Private Sub sfm_Current()
     EintragAnzeigen
End Sub

Die hier aufgerufene Prozedur EintragAnzeigen besprechen wir jedoch weiter unten.

Fundstellen ermitteln

Wenn der Benutzer einen Suchbegriff in das Textfeld txtSuchbegriff eingegeben hat und entweder die Eingabetaste betätigt oder auf die Schaltfläche cmdSuchen klickt, löst er damit die Ereignisprozedur cmdSuchen_Click aus, die Sie in Listing 1 finden.

Private Sub cmdSuchen_Click()
     Dim db As DAO.Database
     Dim rst As DAO.Recordset
     Dim strSuche As String
     If Len(Nz(Me!txtSuchbegriff, "")) = 0 Then
         MsgBox "Bitte geben Sie einen Suchbegriff ein."
         Exit Sub
     End If
     strSuche = Me!txtSuchbegriff
     DoCmd.Hourglass True
     Set db = CurrentDb
     Set rst = db.OpenRecordset("SELECT * FROM tblBeitraege WHERE TextRoh LIKE ''*" & strSuche & "*''", dbOpenDynaset)
     db.Execute "DELETE FROM tblFundstellen", dbFailOnError
     Do While Not rst.EOF
         TextDurchsuchen rst!TextRoh, strSuche, rst!BeitragID, db
         rst.MoveNext
     Loop
     Me!sfmVolltextsuche.Form.Requery
     If Not DCount("*", "tblFundstellen") = 0 Then
         Me.Filter = ""
         EintragAnzeigen
     Else
         Me!txtCode = Null
         Me.Filter = "1=2"
     End If
     Me.FilterOn = True
     DoCmd.Hourglass False
End Sub

Listing 1: Diese Prozedur wird beim Klick auf die Schaltfläche cmdSuchen ausgelöst.

Diese Prozedur prüft zunächst, ob das Textfeld txtSuchbegriff überhaupt einen Suchbegriff enthält. Ist das nicht der Fall, erscheint eine entsprechende Meldung und die Prozedur wird beendet.

Anderenfalls speichert die Prozedur den Suchbegriff aus dem Textfeld in der Variablen strSuche und aktiviert die Anzeige der Sanduhr. Dann füllt sie die Variable db mit einem Verweis auf das aktuelle Database-Objekt. Die Variable rst erhält ein Recordset, das alle Datensätze der Tabelle tblBeitraege enthält, deren Feld TextRoh das Suchergebnis enthält.

Damit filtern wir alle Einträge der Tabelle heraus, die als Quelle für Fundstellen infrage kommen. Die folgende Anweisung löscht dann alle gegebenenfalls noch vorhandenen Einträge der Tabelle tblFundstellen.

Anschließend durchläuft die Prozedur alle Datensätze des Recordsets aus rst, also die Datensätze der Tabelle tblBeitraege, die den gesuchten Begriff enthalten.

Dabei ruft sie für jeden Datensatz die Prozedur TextDurchsuchen auf und übergibt den zu durchsuchenden Text, den Suchbegriff, die ID des Beitrags sowie einen Verweis auf das Database-Objekt der aktuellen Datenbank. Diese Prozedur schauen wir uns gleich im Detail an. Nur so viel: Sie durchsucht den kompletten Text nach Fundstellen und trägt diese dann in die Tabelle tblFundstellen ein.

Ist dies erledigt und die Tabelle tblFundstellen mit einigen Einträgen gefüllt, wird das Unterformular, das ja an diese Tabelle gebunden ist, aktualisiert.

Sollte keine Fundstelle vorhanden sein, wird der Filter des Hauptformulars über die Eigenschaft Filter auf 1=2 eingestellt, was einem Filter entspricht, der keinen Datensatz zurückliefert. Wurden jedoch Einträge gefunden, wird der Filter geleert, sodass alle Einträge der zugrunde liegenden Tabelle über die Datenherkunft verfügbar sind, und die Prozedur EintragAnzeigen aufgerufen. Auch diese schauen wir uns weiter unten an. Mit dem Ausblenden des Sanduhr-Symbols ist die Suche beendet.

Durchsuchen eines Beitrags

Die Prozedur TextDurchsuchen nimmt sich den in einem Datensatz der Tabelle tblBeitraege gespeicherten Text vor und durchsucht ihn nach allen Vorkommen des gesuchten Textes (s. Listing 2). Sie erwartet den Text (strInhalt), den Suchbegriff (strSuche), die ID des Datensatzes, aus dem der Inhalt stammt und einen Verweis auf das Database-Objekt der aktuellen Datenbank als Parameter.

Private Sub TextDurchsuchen(strInhalt As String, strSuche As String, lngBeitragID As Long, db As DAO.Database)
     Dim bolErsteZeile As Boolean
     Dim lngPosStart As Long, lngPosEnde As Long, lngStart As Long, lngEnde As Long
     Dim strAusschnitt As String, strSQL As String
     bolErsteZeile = False
     lngPosStart = InStr(1, strInhalt, strSuche)
     Do While Not lngPosStart = 0
         lngStart = InStrRev(strInhalt, vbCrLf, lngPosStart)
         If lngStart = 0 Then
             lngStart = 1
             bolErsteZeile = True
         Else
             bolErsteZeile = False
         End If
         lngStart = InStrRev(strInhalt, vbCrLf, lngStart)
         If lngStart = 0 Then bolErsteZeile = True
         lngEnde = InStr(lngPosStart, strInhalt, vbCrLf)
         lngEnde = InStr(lngEnde + 2, strInhalt, vbCrLf)
         If lngEnde = 0 Then
             lngEnde = Len(strInhalt)
         End If
         If Not bolErsteZeile Then
             If lngEnde > lngStart Then
                 strAusschnitt = Mid(strInhalt, lngStart + 2, lngEnde - lngStart - 2)
             Else
                 strAusschnitt = Mid(strInhalt, lngStart + 2)
             End If
         Else
             strAusschnitt = Mid(strInhalt, lngStart + 1, lngEnde - lngStart - 1)
         End If
         strAusschnitt = Replace(strAusschnitt, "<", "<")
         strAusschnitt = Replace(strAusschnitt, ">", ">")
         strAusschnitt = Replace(strAusschnitt, strSuche, "<font color=red>" & Mid(strInhalt, lngPosStart, _
             Len(strSuche)) & "</font>")
         strAusschnitt = Replace(strAusschnitt, " <font", " <font")
         lngPosEnde = InStr(lngPosStart + 1, strInhalt, vbCrLf)
         If lngPosEnde = 0 Then
             lngPosEnde = Len(strInhalt)
         End If
         If Not bolErsteZeile Then
             lngPosStart = InStr(lngPosEnde + 1, strInhalt, strSuche)
         Else
             lngPosStart = InStr(lngPosEnde + 1, strInhalt, strSuche) '' + 1
         End If
         strSQL = "INSERT INTO tblFundstellen(BeitragID, Fundstelle) VALUES(" & lngBeitragID & ", ''" _
             & Replace(Replace(Replace(strAusschnitt, "''", "''''"), vbCrLf, "<br>"), """", """""") & "'')"
         db.Execute strSQL, dbFailOnError
     Loop
End Sub

Möchten Sie weiterlesen? Dann lösen Sie Ihr Ticket!
Hier geht es zur Bestellung des Jahresabonnements des Magazins Access im Unternehmen:
Zur Bestellung ...
Danach greifen Sie sofort auf alle rund 1.000 Artikel unseres Angebots zu - auch auf diesen hier!
Oder haben Sie bereits Zugangsdaten? Dann loggen Sie sich gleich hier ein:

Schreibe einen Kommentar