ChatGpt
Der sauberste Weg in Access 2010 ist ein VBA-Makro, das alle gespeicherten Abfragen durchgeht, aus jeder Abfrage den vorhandenen Darsteller-Filter herauszieht und dann die SQL-Anweisung nach einem einheitlichen Muster neu schreibt.
Wichtig: vorher Datenbank sichern.
Hier ist ein vollständiger Ansatz für ein Standardmodul in Access:
Option Compare Database
Option Explicit
' ==========================================================
' Zweck:
' Alle gespeicherten Auswahlabfragen vereinheitlichen.
'
' Dabei wird:
' 1. jede gespeicherte Abfrage geprüft
' 2. der vorhandene Darsteller-Filter aus WHERE übernommen
' 3. die SELECT-Felder werden einheitlich neu gesetzt
' 4. die Feldreihenfolge wird vereinheitlicht
'
' WICHTIG:
' Vorher unbedingt eine Sicherungskopie der Access-Datei machen.
' ==========================================================
Public Sub AbfragenVereinheitlichen_Testlauf()
' True = nur anzeigen, was geändert würde
' False = wirklich ändern
AbfragenVereinheitlichen True
End Sub
Public Sub AbfragenVereinheitlichen_Echtlauf()
' Erst ausführen, wenn der Testlauf plausibel aussieht
AbfragenVereinheitlichen False
End Sub
Private Sub AbfragenVereinheitlichen(ByVal NurTesten As Boolean)
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim alteSQL As String
Dim neueSQL As String
Dim darstellerFilter As String
Dim geaendert As Long
Dim uebersprungen As Long
Set db = CurrentDb
For Each qdf In db.QueryDefs
' Systemabfragen und temporäre Abfragen überspringen
If Left$(qdf.Name, 1) <> "~" Then
alteSQL = qdf.SQL
' Nur normale SELECT-Abfragen bearbeiten
If IstSelectAbfrage(alteSQL) Then
' Darsteller-Filter aus der vorhandenen Abfrage holen
darstellerFilter = HoleDarstellerFilter(alteSQL)
If Len(darstellerFilter) > 0 Then
' Neue einheitliche SQL-Anweisung bauen
neueSQL = BaueNeueSQL(darstellerFilter)
Debug.Print "----------------------------------------"
Debug.Print "Abfrage: " & qdf.Name
Debug.Print "Alter Darsteller-Filter: " & darstellerFilter
Debug.Print "Neue SQL:"
Debug.Print neueSQL
If NurTesten = False Then
qdf.SQL = neueSQL
End If
geaendert = geaendert + 1
Else
Debug.Print "Übersprungen, kein Darsteller-Filter gefunden: " & qdf.Name
uebersprungen = uebersprungen + 1
End If
Else
uebersprungen = uebersprungen + 1
End If
End If
Next qdf
MsgBox "Fertig." & vbCrLf & _
"Geändert: " & geaendert & vbCrLf & _
"Übersprungen: " & uebersprungen & vbCrLf & _
IIf(NurTesten, "Es war nur ein Testlauf.", "Die Abfragen wurden geändert."), _
vbInformation
End Sub
Private Function IstSelectAbfrage(ByVal sqlText As String) As Boolean
sqlText = LCase$(Trim$(sqlText))
' Nur echte SELECT-Abfragen bearbeiten
IstSelectAbfrage = (Left$(sqlText, 6) = "select")
End Function
Private Function HoleDarstellerFilter(ByVal sqlText As String) As String
Dim posWhere As Long
Dim whereTeil As String
Dim teile() As String
Dim i As Long
Dim kriterium As String
' WHERE-Teil suchen
posWhere = InStr(1, sqlText, " WHERE ", vbTextCompare)
If posWhere = 0 Then
HoleDarstellerFilter = ""
Exit Function
End If
whereTeil = Mid$(sqlText, posWhere + 7)
' ORDER BY abschneiden, falls vorhanden
If InStr(1, whereTeil, " ORDER BY ", vbTextCompare) > 0 Then
whereTeil = Left$(whereTeil, InStr(1, whereTeil, " ORDER BY ", vbTextCompare) - 1)
End If
' GROUP BY abschneiden, falls vorhanden
If InStr(1, whereTeil, " GROUP BY ", vbTextCompare) > 0 Then
whereTeil = Left$(whereTeil, InStr(1, whereTeil, " GROUP BY ", vbTextCompare) - 1)
End If
' HAVING abschneiden, falls vorhanden
If InStr(1, whereTeil, " HAVING ", vbTextCompare) > 0 Then
whereTeil = Left$(whereTeil, InStr(1, whereTeil, " HAVING ", vbTextCompare) - 1)
End If
' Falls mehrere Bedingungen mit AND verbunden sind,
' wird gezielt die Bedingung mit Darsteller gesucht.
teile = Split(whereTeil, "AND")
For i = LBound(teile) To UBound(teile)
kriterium = Trim$(teile(i))
If InStr(1, kriterium, "Darsteller", vbTextCompare) > 0 Then
' Abschließendes Semikolon entfernen
If Right$(kriterium, 1) = ";" Then
kriterium = Left$(kriterium, Len(kriterium) - 1)
End If
HoleDarstellerFilter = kriterium
Exit Function
End If
Next i
' Falls kein AND vorhanden war oder Split nicht gepasst hat:
If InStr(1, whereTeil, "Darsteller", vbTextCompare) > 0 Then
whereTeil = Trim$(whereTeil)
If Right$(whereTeil, 1) = ";" Then
whereTeil = Left$(whereTeil, Len(whereTeil) - 1)
End If
HoleDarstellerFilter = whereTeil
Else
HoleDarstellerFilter = ""
End If
End Function
Private Function BaueNeueSQL(ByVal darstellerFilter As String) As String
' ==========================================================
' HIER musst du dein gewünschtes Ziellayout eintragen.
'
' Tabellenname und Feldnamen bitte an deine Datenbank anpassen.
'
' Beispiel:
' Tabelle: Filme
' Felder:
' Filmtitel
' Jahr
' Genre
' Darsteller
' Bemerkung
' ==========================================================
Dim sqlText As String
sqlText = ""
sqlText = sqlText & "SELECT " & vbCrLf
sqlText = sqlText & " Filme.Filmtitel, " & vbCrLf
sqlText = sqlText & " Filme.Jahr, " & vbCrLf
sqlText = sqlText & " Filme.Genre, " & vbCrLf
sqlText = sqlText & " Filme.Darsteller, " & vbCrLf
sqlText = sqlText & " Filme.Bemerkung " & vbCrLf
sqlText = sqlText & "FROM Filme " & vbCrLf
sqlText = sqlText & "WHERE " & darstellerFilter & " " & vbCrLf
sqlText = sqlText & "ORDER BY Filme.Filmtitel;"
BaueNeueSQL = sqlText
End Function
Du würdest dann zuerst ausführen:
AbfragenVereinheitlichen_Testlauf
Dann im Direktfenster prüfen, welche Abfragen erkannt wurden.
Erst danach:
AbfragenVereinheitlichen_Echtlauf
Der entscheidende Teil ist diese Funktion:
BaueNeueSQL
Dort trägst du einmal dein gewünschtes endgültiges Layout ein. Zum Beispiel:
SELECT Filmtitel, Jahr, Genre, Darsteller
FROM Filme
WHERE Darsteller Like '*Schwarzenegger*'
ORDER BY Filmtitel;
Der Filter
Darsteller Like '*Schauspielername*'
wird aus jeder alten Abfrage übernommen.
Eine wichtige Einschränkung: Der Code funktioniert zuverlässig, wenn die Abfragen halbwegs ähnlich aufgebaut sind und der Darsteller-Filter im WHERE-Teil steht. Wenn du sehr komplexe Abfragen mit verschachtelten Klammern, OR-Verknüpfungen oder mehreren Darsteller-Feldern hast, müsste man die Filter-Erkennung noch robuster machen.
Meine Empfehlung: Erst eine Kopie der Datenbank machen, dann mit 5 bis 10 Abfragen testen, dann den Echtlauf über alle Abfragen starten.