Private Function GetFilter() As String
On Local Error GoTo err_getFilter
 
    Dim tmp As String
    Dim n As Integer
 
    For Each col In cols
 
        If Trim(col.FilterText) <> "" Then
 
            n = n + 1
 
            If n > 1 Then
                tmp = tmp & " AND "
            End If
            'Einer meiner Versuche...
            'Select Case col.ColIndex
            '    Case 6:
            '        tmp = tmp & col.DataField & " LIKE " & col.FilterText & "*"
            '    Case Else
            '        tmp = tmp & col.DataField & " LIKE '" & col.FilterText & _
              "*'"
            'End Select
 
            tmp = tmp & col.DataField & " LIKE '" & col.FilterText & "*'"
 
        End If
    Next col
 
    ' Nur zum Test:
    'Debug.Print tmp
 
    GetFilter = tmp
 
'   -----------------Procedure-Exit---------------
Exit_getFilter:
 
    '   Prozedur verlassen
    Exit Function
 
'   -----------------Err-Handler---------------
err_getFilter:
    MsgBox Err.Description, vbCritical, "Modul:frmObjekte, Proc:GetFilter"
    GetFilter = ""
    Resume Exit_getFilter
End Function

Private Sub tgridObjekte_FilterChange()
On Local Error GoTo err_tgridObjekte_FilterChange
 
 
    With tgridObjekte
        Set cols = .Columns
 
        Dim c As Integer
        c = .col
        .HoldFields
        rsObjects.Filter = GetFilter()
        .col = c
        .EditActive = True
    End With
 
'   -----------------Procedure-Exit---------------
Exit_tgridObjekte_FilterChange:
 
    '   Prozedur verlassen
    Exit Sub
 
'   -----------------Err-Handler---------------
err_tgridObjekte_FilterChange:
 
    Select Case Err.Number
 
        Case -2147217825:
            Err.Clear
            MsgBox "Suche funktioniert in diesem Abschnitt noch nicht!", _
              vbInformation, C_APPNAME
 
        Case -2147217900:
            Err.Clear
            MsgBox "Suche funktioniert in diesem Abschnitt noch nicht!", _
              vbInformation, C_APPNAME
 
        Case 3704:
            Err.Clear
            MsgBox "Suche funktioniert in diesem Abschnitt noch nicht!", _
              vbInformation, C_APPNAME
 
        'Case 3001:
        '    Err.Clear
        '    MsgBox "Suche funktioniert in diesem Abschnitt noch nicht!", 
        ' vbInformation, C_APPNAME
 
        Case Else
            MsgBox Err.Description & Err.Number, vbCritical, "Modul:frmObjekte," & _
              "Proc:tgridObjekte_FilterChange"
            Resume Exit_tgridObjekte_FilterChange
    End Select
End Sub