Office: (Office 2003) VBA prüfen - eventuell Fehler

Hallo Fachkräfte,

hier ein VBA-Modul das einen Fehler enthalten soll. Case 2 wurde in 2022 geändert. In Case 3 , 4 oder ... soll auch noch ein Fehler sein.
Wo genau was falsch ist und wie geändert werden soll, wurde mir nicht mitgeteilt.

Code:

Option Compare Database

Public Sub SQLString(FieldValue As Variant, FieldName As String, _
                     Criteria As String, ArgCount As Integer, _
                     Typ As Integer, Optional Operator As String = "=", _
                     Optional bAnd As Boolean = True)
    '*************************************************************************
    'In dieser Prozedur (Sub) muß und darf nichts geändert werden
    '*************************************************************************
    ' Erstelle Kriterien für die WHERE-Klausel.
    If Nz(FieldValue, "") <> "" Then
        If bAnd Then
            ' Füge "Und" hinzu, falls andere Kriterien vorhanden sind.
            If ArgCount > 0 Then Criteria = Criteria & " AND "
          Else
            ' Füge "Oder" hinzu, falls andere Kriterien vorhanden sind.
            If ArgCount > 0 Then Criteria = Criteria & " OR "
        End If
        Select Case Typ
          Case 1 'Datum
            Criteria = Criteria & FieldName & " " & Operator & "  #" & _
                       Format(CDate(FieldValue), "mm-dd-yyyy") & "#"
          Case 2 'String Like
            Criteria = Criteria & FieldName & " Like '*" & Replace(FieldValue, "'", "''") & "*'"
'                          Geändert am 13. Juni 2022 Vorschlag von MS Office Forum durch Maxel
'            Criteria = Criteria & FieldName & " Like '*" & FieldValue & "*'"
          Case 3 ' Zahl
            Criteria = Criteria & FieldName & " " & Operator & Str(FieldValue)
                          'Fehlendes Str(...) eingefuegt Willi Wipp 2007.08.07
          Case 4 'String =
            If InStr(1, FieldValue, "*") Then
                Criteria = Criteria & FieldName & " Like '" & FieldValue & "'"
              Else
                Criteria = Criteria & FieldName & " = '" & FieldValue & "'"
            End If
          Case 5 'Ja/nein
            If FieldValue = "Ja" Or FieldValue = "True" Or _
               FieldValue = True Then
                Criteria = Criteria & FieldName & " = -1"
              Else
                Criteria = Criteria & FieldName & " = 0"
            End If
          Case 6
            Criteria = Criteria & "(" & FieldName & ") Is Null"
        End Select
        '  Inkrementiere die Zahl der Argumente.
        ArgCount = ArgCount + 1
    End If
End Sub

Public Function ReplaceHochkomma(strString As Variant)
On Error GoTo fehler

    If Nz(strString, 0) <> 0 Then
        ReplaceHochkomma = Replace(strString, "'", "''")
    End If

Exit Function
fehler: MsgBox "Fehler " & Err.Number & ": " & Err.Description, , "Bitte Fehlernummer und Beschreibung an den Administrator melden"
End Function

Meine VBA-Kenntnisse sind sehr gering, darum bitte ich um Unterstützung?

 

Hallo,

der Code ist tatsächlich sehr naja, aber da ich keinen Bock auf sture Fehlersuche in fremdem Code habe, habe ich das der KI überlassen und gebe dir das hier mal ungeprüft weiter:

und

Code:

Public Sub SQLString(FieldValue As Variant, FieldName As String, _
                     Criteria As String, ArgCount As Integer, _
                     Typ As Integer, Optional Operator As String = "=", _
                     Optional bAnd As Boolean = True)
    
    ' Fix für Typ 6 (Null): Wenn Typ 6 gewählt ist, ignorieren wir die Prüfung auf "Leer"
    If Nz(FieldValue, "") <> "" Or Typ = 6 Then
        
        If bAnd Then
            If ArgCount > 0 Then Criteria = Criteria & " AND "
        Else
            If ArgCount > 0 Then Criteria = Criteria & " OR "
        End If
        
        Select Case Typ
          Case 1 'Datum (US-Format für Access SQL)
            Criteria = Criteria & FieldName & " " & Operator & " #" & _
                       Format(CDate(FieldValue), "mm-dd-yyyy") & "#"
                      
          Case 2 'String Like
            Criteria = Criteria & FieldName & " Like '*" & Replace(FieldValue, "'", "''") & "*'"
            
          Case 3 'Zahl
            Criteria = Criteria & FieldName & " " & Operator & Str(FieldValue)
            
          Case 4 'String = (Jetzt MIT Hochkomma-Schutz)
            Dim safeValue As String
            safeValue = Replace(FieldValue, "'", "''")
            If InStr(1, FieldValue, "*") Then
                Criteria = Criteria & FieldName & " Like '" & safeValue & "'"
            Else
                Criteria = Criteria & FieldName & " " & Operator & " '" & safeValue & "'"
            End If
            
          Case 5 'Ja/nein (Sichere Prüfung auf True/False)
            If FieldValue = "Ja" Or FieldValue = "True" Or FieldValue = True Or FieldValue = -1 Then
                Criteria = Criteria & FieldName & " = -1"
            Else
                Criteria = Criteria & FieldName & " = 0"
            End If
            
          Case 6 'Is Null (Funktioniert jetzt, da die äußere If-Bedingung angepasst wurde)
            Criteria = Criteria & "(" & FieldName & ") Is Null"
        End Select
        
        ArgCount = ArgCount + 1
    End If
End Sub

Public Function ReplaceHochkomma(strString As Variant) As String
On Error GoTo fehler

    ' Sicherer Vergleich auf leere Strings statt numerischem Vergleich
    If Nz(strString, "") <> "" Then
        ReplaceHochkomma = Replace(strString, "'", "''")
    Else
        ReplaceHochkomma = ""
    End If

Exit Function
fehler:
    MsgBox "Fehler " & Err.Number & ": " & Err.Description, , "Fehler in ReplaceHochkomma"
    ReplaceHochkomma = ""
End Function

Das Testen überlasse ich dann mal dir.

Knobbi38