Diese Klasse hilft Filterstrings zu erstellen. Sie hat mehr möglichkeiten als die BuildCriteria aus MS Access

Für die Ausgabe der Resultate verwendete ich die Funktion print_r() bzw. d().

Es gibt verschiedene Möglichkeiten ein DateTime zu initialisieren

Ob instance() oder construct(). Die Parameterreihenfolge und das Verhalten der Parameter sind gleich. Ich nehme darum nur instance und gebe das Resultat direkt mit filterText aus.

Einfache Aufrufe. Tabellen-/Feldnamen werden automatisch erkannt und auch der ValueTyp

? YFilter("id", 13).filterText
[id] = 13
 
? YFilter("mytable.id", 13).filterText
[mytable].[id] = 13
 
? YFilter("name", "Yaslaw").filterText
[name] = "Yaslaw"
 
? YFilter("name", "Yaslaw*").filterText
[name] LIKE "Yaslaw*"

Für ein Between oder ein IN(), können einfach die Values als Array übergeben werden

? YFilter("id", array(13, 42)).filterText
([id] BETWEEN 13 AND 42)
 
? YFilter("id", array(13, 42, 72)).filterText
[id] IN (13, 42, 72)

Manchmal macht es Sinn, ein Filter direkt einzugeben. Zm Beispiel als Untefilter bei createAnd

? YFilter("id = 123").filterText
id = 123
 
'Wenn der erste Parameter als Feldnamen erkannt wird, dann wird auf NULL geprüft 
? YFilter("id").filterText
[id] IS NULL

Mit 3 Parametern kann man dem Filter auch auf die Sprünge helfen, damit klar ist, was man haben will.

'Ohne FilterType & ValueType
? YFilter("id", "123").filterText
[id] = 123
 
'ValueType als String
? YFilter("id", "123",, evtString).filterText
[id] = "123"
 
'Mit FilterType Less or Equal
? YFilter("id", "123", eftLe).filterText
[id] <= 123
 
'Prüfung auf NULL erzwingen
? YFilter("id", "123",eftNull).filterText
[id] IS NULL
 
'Und auf Not Null
? YFilter("id", "123",eftNull + eftNot).filterText
[id] NOT IS NULL
 
'ein einfacher NOT-Filter
? YFilter("id", 123, eftNot).filterText
NOT [id] = 123

Mit mehreren Werten.

'Ohne Typedefinitionen
? YFilter("id", array(13, 42)).filterText
([id] BETWEEN 13 AND 42)
 
'Als IN() anstelle von BETWEEN
? YFilter("id", array(13, 42), eftIn).filterText
[id] IN (13, 42)
 
'und mit NOT kombiniert als String-Vergleich
? YFilter("id", array(13, 42), eftNot + eftIn, evtString).filterText
[id] NOT IN ("13", "42")

Einige Beispiele zu weiteren Parameter

'Logik umdrehen. Der erste Wert ist ein Value, die Zweiten sind Felder
?YFilter("abc", array("Code1", "Code2"),,,efpFirstIsValue+efpSecoundIsName).filterText
("abc" BETWEEN [Code1] AND [Code2])
 
'Wenn das erste Feld klar kein Feldname ist, dnn kann efpFirstIsValue auch weggelassen werden
?YFilter(#05-15-2016#, array("from_date", "to_date"),,,efpSecoundIsName).filterText
(#05-15-2016 00:00:00# BETWEEN [from_date] AND [to_date])
 
'Ein Boolean-Text ohne Parameter efpParseBooleanString
?YFilter("t2.flag1", "True").filterText
[t2].[flag1] = "True"
 
'und mit Parameter efpParseBooleanString
?YFilter("t2.flag1", "True",,,efpParseBooleanString).filterText
[t2].[flag1] = True

Set myFiler = YFilter.instance(filterName, [values [,FilterType [,ValueType [,FilterParameters]]]])
Set myFiler = YFilter(filterName, [values [,FilterType [,ValueType [,FilterParameters]]]])

'/**
' * erstellt ein Filter und gibt den Filterstring zurück
' * @param  String          Feldname
' * @param  Variant         Ein Wert oder ein Array mit Werten
' * @param  eFilterTypes    Type des Filters. eftNot lässt sich mit den restlichen kombinieren
' * @param  eValueTypes     Type des Vergleichsvalue
' * @param  eFilterParams   Diverse weitere Einstellungen
' * @return String
' */
Public Static Function instance( _
    Optional ByRef iItems1 As Variant = Empty, _
    Optional ByRef iItems2 As Variant = Null, _
    Optional ByVal iFilterType As eFilterTypes, _
    Optional ByVal iValueType As eValueTypes, _
    Optional ByVal iFilterParams As eFilterParams _
) As YFilter
'Attribute instance.VB_UserMemId = 0
    Set instance = New YFilter
    instance.construct iItems1, iItems2, iFilterType, iValueType, iFilterParams
End Function

print_r YFilter("id", 13)
<Class Module::YFilter>  (
    [filterText] => <String> '[id] = 13'
    [fieldName] => <String> '[id]'
    [valueType] => <Long> 19
    [values] => <Variant()>  (
        [0] => <Integer> 13
    )
    [filterType] => <Long> 128
    [isNotFilter] => <Boolean> False
)
 
? YFilter("id", array(13, 42)).filterText
([id] BETWEEN 13 AND 42)
 
YFilter("id", array(13, 42, 72)).filterText
[id] IN (13, 42, 72)

Set myFiler = new YFilter: myFilter.construct [values [,FilterType [,ValueType [,FilterParameters]]]]

'/**
' * Initialisiert ein Filterobjekt
' * @param  String      Feldname
' * @param  Variant     Ein Wert oder ein Array mit Werten
' * @param  eFilterTypes Type des Filters. eftNot lässt sich mit den restlichen kombinieren
' * @param  eValueTypes  Type des Vergleichsvalue
' * @param  eFilterParams   Diverse weitere Einstellungen
' * @return YFilter
' */
Public Function construct( _
    Optional ByRef iItems1 As Variant = Empty, _
    Optional ByRef iItems2 As Variant = Null, _
    Optional ByVal iFilterType As eFilterTypes, _
    Optional ByVal iValueType As eValueTypes, _
    Optional ByVal iFilterParams As eFilterParams _
) As YFilter

Dim myFilter As YFilter
myFilter.construct "id", 13

Set myFiler = YFilter.createAnd([filter [,filter [...]])

'/**
' * @param  Array<Filter>   Filter die mit AND verknüpft werden
' * @return Filter
' */
Public Static Function createAnd(ParamArray iFilters() As Variant) As YFilter

? YFilter.createAnd(YFilter("id", 13), YFilter("flag", true)).filterText
([id] = 13) AND ([flag] = True)

Erstellt ein OR-Filter

Set myFiler = YFilter.createOr([filter [,filter [...]])

'/**
' * @param  Array<Filter>   Filter die mit OR verknüpft werden
' * @return Filter
' */
Public Static Function createOr(ParamArray iFilters() As Variant) As YFilter
    pSubIdx = -1
    Set createOr = New YFilter
    createOr.filterType = [_OR]
    Dim idx As Integer: For idx = 0 To UBound(iFilters)
        createOr.addFilter iFilters(idx)
    Next idx
End Function

? YFilter.createOr(yfilter.createAnd(YFilter("id", 13), YFilter("flag", true)), "master = 0").filterText
(([id] = 13) AND ([flag] = True)) OR (master = 0)

Siehe auch [VBA] flexible Filter.

yfilter.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "YFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Attribute VB_PredeclaredId = True
'-------------------------------------------------------------------------------
'File         : Filter.cls
'               Copyright mpl by ERB software
'               All rights reserved
'Environment  : VBA 2007 +
'Version      : 2.1.0
'Name         : Filter
'Author       : Stefan Erb (ERS)
'History      : 26.06.2014 - ERS - CreationOption Explicit
'               07.01.2016 - ERS - Totalüberholt
'               15.01.2016 - ERS - Add Property isActive
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * Mit hilfe dieser Klasse kann man relativ einfach Filter-Strings generieren
' *
' *     Set myFiler = YFilter(filterName, [values [,FilterType [,ValueType]]])
' *
' * @example    Dim f As YFilter: Set f=YFilter("t.id", 1234)
' * @example    Debug.Print YFilter("name", "*erb*", eftLike).filterText
' * @example    Debug.Print YFilter("test = 1234").filterText
' * @example    Dim f As YFilter: Set f = YFilter.createAnd(Filter("abc"))
' *             f.addFilter YFilter("a", Array(1, 4), , evtString)
' *             Debug.Print f.filterText
' */
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
 
'/**
' * Vergleichstype
' * eftNot kann mit allen anderen kombiniert werden: eftNot + eftEq
' */
Public Enum eFilterTypes
    eftAutomatic = 0                'Filtertyp wird automatisch ermittelt
    eftnot = 2 ^ 0                  'Ein NOT wird davor gesetzt
    [_AND] = 2 ^ 1                  'Versteckt: AND-Filter
    [_OR] = 2 ^ 2                   'Versteckt: OR-Filter
    eftBetween = 2 ^ 3              'Between Value_1 and Value_2
    eftBetweenVB = 2 ^ 4            'Value_1 <= [feld] AND [feld] <= Value_2
    eftIn = 2 ^ 5                   'IN()
    eftNull = 2 ^ 6                 'IS NULL
    efteq = 2 ^ 7                   '==
    eftNe = 2 ^ 8                   '!=
    eftLt = 2 ^ 9                   '<
    eftGt = 2 ^ 10                  '>
    eftLe = 2 ^ 11                  '<=
    eftGe = 2 ^ 12                  '>=
    eftEmpty = 2 ^ 13               'ISEMPTY()
    eftNothing = 2 ^ 14             'NULL or TRIM()="" or EMPTY: TRIM(NZ([feld])) = ""
    eftLike = 2 ^ 15                'Ein LIKE Filter
    eftEqLike = 2 ^ 16              'Like oder EQ, je nachdem was der Wert hergibt
    eftDirect = 2 ^ 17              'Direkt ein Filterstring eingeben
End Enum
 
'/**
' * Reduzierte Liste für die FilterTypes
' */
Public Enum eListFilterTypes
    elfAnd = eFilterTypes.[_AND]
    elfOr = eFilterTypes.[_OR]
    elfNot = eFilterTypes.eftnot
End Enum
 
'/**
' * Datentype. Reihenfolge: Je höher, umso wichtiger
' */
Public Enum eValueTypes
    evtAutomatic = 0
    evtnull = 2 ^ 1
    evtempty = 2 ^ 2
    evtBoolean = dbBoolean
    evtTime = dbTime                'Nur Zeit
    evtDate = dbDate                'Nur Datum
    evtDateTime = dbTimeStamp       'Datum & Zeit
    evtNumber = dbNumeric
    evtString = dbText
End Enum
 
'/**
' * Angabe, ob es isch um ein Feldname oder ein Value handelt
' */
Public Enum eParseType
    eptAutomatic = 0
    eptFieldName = 2 ^ 0            'Feldnamem: [feld] oder [tabelle].[feld]
    eptValue = 2 ^ 1                'Wert: 123 oder "abc" oder #31-12-21015#
End Enum
 
'/**
' * Weitere Parameters
' */
Public Enum eFilterParams
    efpAutomatic = 0
    efpParseNullText = 2 ^ 0        '[fnn] Der Text Null ohne Delemiter wird als Wert Null intepretiert
    efpEmptyAsNull = 2 ^ 1          '[fen] Ein leerer String wird als Null intepretiert
    efpParseBooleanString = 2 ^ 2   '[ftb] "True", "False" werden als Boolean geparst
    efpWithNz = 2 ^ 3               '[fnz]
 
    efpFirstIsValue = 2 ^ 6         '[v1]Erste Eingabe ist ein Wert
    efpFirstIsName = 2 ^ 7          '[n1]Erste Eingabe ist ein Feldname
    efpSecoundIsValue = 2 ^ 8       '[v1]Zweite Eingabe ist ein Wert
    efpSecoundIsName = 2 ^ 9        '[n1]Zweite Eingabe ist ein Feldname
End Enum
 
'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
 
Private pRawFilterType          As eFilterTypes
Private pFixValueType           As eValueTypes
Private pFilterParams           As eFilterParams
Private pRawItems1()            As Variant
Private pRawItems2()            As Variant
Private pRawParseType1          As eParseType
Private pRawParseType2          As eParseType
Private pSubs                   As Collection
Private pNot                    As Boolean
 
'-------------------------------------------------------------------------------
' -- Public Constructors
'-------------------------------------------------------------------------------
'/**
' * Der NewEnum wird für die For Each.. Next Schleife verwendet
' *
' * Diese Funktion hat das Attribut "'Attribute NewEnum.VB_UserMemId = -4"
' * !! Diese Iterierung hat keinen Einfluss auf die aktuelle Position !!
' *
' * @return Das nächste element
' */
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = pSubs.[_NewEnum]
End Function
 
'/**
' * erstellt ein Filter und gibt den Filterstring zurück
' *
' *     String = YFilter(filterName, [values [,FilterType [,ValueType]]])
' *
' * @param  String          Feldname
' * @param  Variant         Ein Wert oder ein Array mit Werten
' * @param  eFilterTypes    Type des Filters. eftNot lässt sich mit den restlichen kombinieren
' * @param  eValueTypes     Type des Vergleichsvalue
' * @param  eFilterParams   Diverse weitere Einstellungen
' * @return String
' */
Public Static Function instance( _
    Optional ByRef iItems1 As Variant = Empty, _
    Optional ByRef iItems2 As Variant = Null, _
    Optional ByVal iFilterType As eFilterTypes, _
    Optional ByVal iValueType As eValueTypes, _
    Optional ByVal iFilterParams As eFilterParams _
) As YFilter
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New YFilter
    instance.construct iItems1, iItems2, iFilterType, iValueType, iFilterParams
End Function
 
'/**
' * Initialisiert ein Filterobjekt
' *
' *     myFilter.construct filterName, [values [,FilterType [,ValueType]]]
' *
' * @param  String      Feldname
' * @param  Variant     Ein Wert oder ein Array mit Werten
' * @param  eFilterTypes Type des Filters. eftNot lässt sich mit den restlichen kombinieren
' * @param  eValueTypes  Type des Vergleichsvalue
' * @param  eFilterParams   Diverse weitere Einstellungen
' * @return YFilter
' */
Public Function construct( _
    Optional ByRef iItems1 As Variant = Empty, _
    Optional ByRef iItems2 As Variant = Null, _
    Optional ByVal iFilterType As eFilterTypes, _
    Optional ByVal iValueType As eValueTypes, _
    Optional ByVal iFilterParams As eFilterParams _
) As YFilter
 
    items1 = iItems1
    items2 = iItems2
    filterType = iFilterType
    valueType = iValueType
    filterParams = iFilterParams
 
    Set construct = Me
End Function
 
'/**
' * erstellt ein AND-Filter
' * @param  Array<Filter>   Filter die mit AND verknüpft werden
' * @return Filter
' */
Public Static Function createAnd(ParamArray iFilters() As Variant) As YFilter
    Set createAnd = YFilter.createFilterList(elfAnd, CVar(iFilters))
End Function
 
Public Static Function createAndNot(ParamArray iFilters() As Variant) As YFilter
    Set createAndNot = YFilter.createFilterList(elfAnd + elfNot, CVar(iFilters))
End Function
 
'/**
' * erstellt ein OR-Filter
' * @param  Array<Filter>   Filter die mit OR verknüpft werden
' * @return Filter
' */
Public Static Function createOr(ParamArray iFilters() As Variant) As YFilter
    Set createOr = YFilter.createFilterList(elfOr, CVar(iFilters))
End Function
Public Static Function createOrNot(ParamArray iFilters() As Variant) As YFilter
    Set createOrNot = YFilter.createFilterList(elfOr + elfNot, CVar(iFilters))
End Function
 
'/**
' * Erstellt ein Filter mit Subfilter aus einem Array
' * @param  eListFilterTypes        Reduzierter Filtertype
' * @param  Array<YFilter/Strin>
' * @retur  YFilter
' */
Public Static Function createFilterList(ByVal iFilterType As eListFilterTypes, ByRef iFilters As Variant) As YFilter
    Set createFilterList = New YFilter
    createFilterList.filterType = iFilterType
    Dim idx As Integer: For idx = 0 To UBound(iFilters)
        createFilterList.addFilter iFilters(idx)
    Next idx
End Function
 
'-------------------------------------------------------------------------------
' -- Public methodes
'------------------------------------------------------------------------------
'/**
' * Fügt ein Filter hinzu. Wird für AND und OR verwendet
' * @param  Filter
' * @return Filter
' */
Public Function addFilter(ByRef iFilter As Variant) As YFilter
    If Not (pRawFilterType = [_AND] Or pRawFilterType = [_OR]) Then Err.Raise 419       'Permission to use object denied
 
    Dim fil As YFilter
    If Not TypeName(iFilter) = "YFilter" Then
        Set fil = YFilter.instance(iFilter)
    Else
        Set fil = iFilter
    End If
    pSubs.add fil
    Set addFilter = Me
End Function
 
'/**
' * Entspricht myFilter.addFilter(Filter(...))
' * @param  String          Feldname
' * @param  Variant         Ein Wert oder ein Array mit Werten
' * @param  eFilterTypes    Type des Filters. eftNot lässt sich mit den restlichen kombinieren
' * @param  eValueTypes     Type des Vergleichsvalue
' * @param  eFilterParams   Diverse weitere Einstellungen
' * @return Filter
' */
Public Function addNewFilter( _
    Optional ByRef iItems1 As Variant = Empty, _
    Optional ByRef iItems2 As Variant = Null, _
    Optional ByVal iFilterType As eFilterTypes = eftAutomatic, _
    Optional ByVal iValueType As eValueTypes, _
    Optional ByVal iFilterParams As eFilterParams = efpAutomatic _
) As YFilter
    If Not (pRawFilterType = [_AND] Or pRawFilterType = [_OR]) Then Err.Raise 419       'Permission to use object denied
    pSubs.add YFilter(iItems1, iItems2, iFilterType, iValueType, iFilterParams)
    Set addNewFilter = Me
End Function
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
 
'/**
' * Angabe, ob ein Filter definiert ist
' * @return Boolean
' */
Public Property Get isActive() As Boolean
    isActive = Len(filterText) > 0
End Property
 
'/**
' * Gibt den Filter als Filterstring zurück
' * @return String
' */
Public Property Get filterText() As String
    Dim pattern     As String
    Dim mFilterType As eFilterTypes:  mFilterType = filterType
 
    'Spezialregelung für AND und OR Filter
    If (mFilterType And [_AND] + [_OR]) Then
        If pSubs.Count = 0 Then Exit Sub
        Dim fStrings() As String: ReDim fStrings(pSubs.Count - 1)
        Dim idx As Integer: For idx = 0 To pSubs.Count - 1
            fStrings(idx) = "(" & pSubs(idx + 1).filterText & ")"
        Next idx
        filterText = Join(fStrings, IIf(mFilterType = [_AND], " AND ", " OR "))
        If isNotFilter Then filterText = "NOT (" & filterText & ")"
        Exit Property
    End If
 
    'wähle den Filterpattern
    Select Case mFilterType
        Case eftNull:        pattern = "{$value1} {$not}IS NULL"
        Case eftEmpty:       pattern = "{$not}ISEMPTY({$value1})"
        Case eftBetween:     pattern = "{$not}({$value1} BETWEEN {$value2.1} AND {$value2.2})"
        Case eftBetweenVB:   pattern = "{$not}({$value2.1} <= {$value1} AND {$value1} <= {$value2.2})"
        Case eftIn:          pattern = "{$value1} {$not}IN ({$values2})"
        Case eftNe:          pattern = "{$not}(NOT {$value1} = {$value2.1})"
        Case eftLt:          pattern = "{$not}{$value1} < {$value2.1}"
        Case eftGt:          pattern = "{$not}{$value1} > {$value2.1}"
        Case eftLe:          pattern = "{$not}{$value1} <= {$value2.1}"
        Case eftGe:          pattern = "{$not}{$value1} >= {$value2.1}"
        Case eftNothing:     pattern = "{$not}TRIM(NZ({$value1})) = """""
        Case efteq:          pattern = "{$not}{$value1} = {$value2.1}"
        Case eftDirect:      pattern = "{$not}{$value1}"
        Case Else:           pattern = "{$not}{$value1} LIKE {$value2.1}"
    End Select
 
    'Die Textsegmente erstellen
    Dim items1() As Variant: items1 = sqlItems1
    Dim items2() As Variant: items2 = sqlItems2
 
    'Den Filterpattern parsen
    filterText = pattern
    filterText = Replace(filterText, "{$value1}", items1(0))                'Erstes Feld ersetzen
    filterText = Replace(filterText, "{$values2}", Join(items2, ", "))      '2tes Feld mit mehreren Values ersetzen
    filterText = Replace(filterText, "{$value2.1}", NZ(items2(0)))          'Zweites Feld, Erster Wert
    If UBound(items2) > 0 Then filterText = Replace(filterText, "{$value2.2}", NZ(items2(1)))   'Zweites Feld, zweites Feld
    filterText = Replace(filterText, "{$not}", IIf(isNotFilter, "NOT ", Empty))    'Not-Part (inkl. Splace): "NOT "
    filterText = Trim(filterText)
End Property
 
'/**
' * SubFilters bei AND und OR
' * @return Array<YFilter>
' */
Public Property Get subFilters() As YFilter()
    Dim retArr() As YFilter: ReDim retArr(pSubs.Count - 1)
    Dim i As Long: For i = 0 To pSubs.Count - 1
        Set retArr(i) = pSubs(i + 1)
    Next i
    subFilters = retArr
End Property
 
'/**
' * Item 1 in der Roh-Form (Original)
' * @return Array<Variant>
' */
Public Property Get items1() As Variant
    items1 = pRawItems1
End Property
Public Property Let items1(ByRef iItems1 As Variant)
    pRawItems1 = IIf(IsArray(iItems1), iItems1, Array(iItems1))
End Property
 
'/**
' * Item 2 in der Roh-Form (Original)
' * @return Array<Variant>
' */
Public Property Get items2() As Variant
    items2 = pRawItems2
End Property
Public Property Let items2(ByRef iItems2 As Variant)
    pRawItems2 = IIf(IsArray(iItems2), iItems2, Array(iItems2))
End Property
 
'/**
' * SqlItem 1
' * @return Array<String>
' */
Public Property Get sqlItems1() As Variant
    sqlItems1 = castToSql(pRawItems1, parseType1)
End Property
 
'/**
' * SqlItem 2
' * @return Array<String>
' */
Public Property Get sqlItems2() As Variant
    sqlItems2 = castToSql(pRawItems2, parseType2)
End Property
 
'/**
' * ParseTyp zu Item 1
' * @return eParseType
' */
Public Property Get parseType1() As eParseType
    If andB(pFilterParams, efpFirstIsName) Then
        parseType1 = eptFieldName
        Exit Property
    End If
 
    If andB(pFilterParams, efpFirstIsValue) Then
        parseType1 = eptValue
        Exit Property
    End If
 
    parseType1 = IIf(rxIsName.test(NZ(pRawItems1(0))), eptFieldName, eptValue)
End Property
Public Property Let parseType1(ByVal iParseType As eParseType)
    pRawParseType1 = iParseType
End Property
 
'/**
' * ParseTyp zu Item 2
' * @return eParseType
' */
Public Property Get parseType2() As eParseType
    If andB(pFilterParams, efpSecoundIsName) Then
        parseType2 = eptFieldName
        Exit Property
    End If
 
    If andB(pFilterParams, efpSecoundIsValue) Then
        parseType2 = eptValue
        Exit Property
    End If
 
    If rxIsName.test(NZ(pRawItems1(0))) Then
        'Wenn der String in als Name erkannt und der Feldname in [] gesetzt ist, dann als Namen zurückgeben
        parseType2 = IIf(rxIsName.Replace(NZ(pRawItems1(0)), "$4") = "", eptValue, eptFieldName)
    Else
        parseType2 = eptValue
    End If
End Property
Public Property Let parseType2(ByVal iParseType As eParseType)
    pRawParseType2 = iParseType
End Property
 
'/**
' * Typ der Items
' * @return eValueTypes
' */
Public Property Get valueType() As eValueTypes
    'Wenn der ValueType bereits fix gesetzt ist, muss nicht ermittelt werden
    If pFixValueType <> evtAutomatic Then
        valueType = pFixValueType
        Exit Property
    End If
 
    Dim vt1 As eValueTypes
    Dim vt2 As eValueTypes
 
    If pFixValueType = evtAutomatic Then
        If parseType1 = eptValue Then vt1 = getValueType(items1)
        If parseType2 = eptValue Then vt2 = getValueType(items2)
    End If
 
    'Gewichtet auswählen
    valueType = greatest(vt1, vt2)
End Property
Public Property Let valueType(ByVal iValueType As eValueTypes)
    pFixValueType = iValueType
End Property
 
'/**
' * Parameter zum Filter
' * @return eFilterParams
' */
Public Property Get filterParams() As eFilterParams
    filterParams = pFilterParams
End Property
Public Property Let filterParams(ByVal iFilterParams As eFilterParams)
    pFilterParams = iFilterParams
End Property
 
'/**
' * Parameter: Leere Zeichenfolge als Null interpretieren
' * @return Boolean
' */
Public Property Get paramEmptyAsNull() As Boolean
    paramEmptyAsNull = andB(filterParams, efpEmptyAsNull)
End Property
Public Property Let paramEmptyAsNull(ByVal iBoolean As Boolean)
    filterParams = addB(filterParams, efpEmptyAsNull)
End Property
 
'/**
' * Parameter: Text "True" und "False" als Boolen inerpretieren
' * @return Boolean
' */
Public Property Get paramParseBooleanString() As Boolean
    paramParseBooleanString = andB(filterParams, efpParseBooleanString)
End Property
Public Property Let paramParseBooleanString(ByVal iBoolean As Boolean)
    filterParams = addB(filterParams, efpParseBooleanString)
End Property
 
'/**
' * Parameter: Text "Null" als Null interpretieren
' * @return Boolean
' */
Public Property Get paramParseNullText() As Boolean
    paramParseNullText = andB(filterParams, efpParseNullText)
End Property
Public Property Let paramParseNullText(ByVal iBoolean As Boolean)
    filterParams = addB(filterParams, efpParseNullText)
End Property
 
'/**
' * Parameter: Felder mit NZ() umschliessen
' * @return Boolean
' */
Public Property Get paramWithNz() As Boolean
    paramWithNz = andB(filterParams, efpWithNz)
End Property
 
Public Property Let paramWithNz(ByVal iBoolean As Boolean)
    filterParams = addB(filterParams, efpWithNz)
End Property
 
'/**
' * Typ des Filters
' * @return eFilterTypes
' */
Public Property Get filterType() As eFilterTypes
    'Der Filtertyp ist vergegeben.
    If Not (pRawFilterType = eftAutomatic Or pRawFilterType = eftnot) Then
        filterType = pRawFilterType
        Exit Property
    End If
 
    'FilterTyp ermitteln
    Dim isNot As Boolean:   isNot = (pRawFilterType = eftnot)
    Dim vt As eValueTypes:  vt = valueType
 
    'ANhand der Anzahl Werte in items2
    Select Case UBound(items2)
        'Es gibt nur ein Wert
        Case 0:
            filterType = Switch( _
                parseType1 = eptValue And (IsNull(items2(0)) Or vt = evtnull), eftDirect, _
                vt = evtnull, eftNull, _
                rxLike.test(NZ(sqlItems2(0))), eftEqLike, _
                True, efteq _
            )
        'Bei 2 Werten ein Between erstellen
        Case 1:     filterType = eftBetween
        'Bei mehr als 2, ein IN()
        Case Else:  filterType = eftIn
    End Select
 
    ''ggf das NOT wieder anhängen
    If isNot Then filterType = addB(filterType, eftnot)
 
End Property
Public Property Let filterType(ByVal iFilterType As eFilterTypes)
    isNotFilter = andB(iFilterType, eftnot)
    pRawFilterType = iFilterType - IIf(isNotFilter, eftnot, 0)
End Property
 
'/**
' * Angabe, ob dem Filter ein NOT vorgestellt werden musss
' * @return Boolean
' * /
Public Property Get isNotFilter() As Boolean
    isNotFilter = pNot
End Property
Public Property Let isNotFilter(ByVal iNot As Boolean)
    pNot = iNot
End Property
 
'-------------------------------------------------------------------------------
' -- Private methodes
'-------------------------------------------------------------------------------
 
'/**
' * gibt den Value oder Feldnamen zurück
' * @param  Variant     Wert/FeldName oder Array(Wert/FeldName, ..)
' * @param  eParseType
' * @return Variant     Formatierter Wert/Feldname oder Array davon
' */
Private Function castToSql(ByVal iItems As Variant, Optional ByVal iParseType As eParseType = eptAutomatic) As Variant
    'Falls ein Array übergeben wird, jedes Eunzelne Element casten
    If IsArray(iItems) Then
        Dim retValues() As Variant: ReDim retValues(LBound(iItems) To UBound(iItems))
        Dim i As Long: For i = LBound(iItems) To UBound(iItems)
            retValues(i) = castToSql(iItems(i), iParseType)
        Next i
        castToSql = retValues
        Exit Function
    End If
 
    iItems = CStr(NZ(iItems))
    castToSql = iItems
    Select Case iParseType
        Case eptAutomatic:  'Automatisch
            castToSql = castToSql(iItems, IIf(rxIsName.test(NZ(iItems)), eptFieldName, eptValue))
        Case eptFieldName:  'FeldName
            castToSql = getFieldName(iItems)
        Case eptValue:      'Value
            Select Case valueType
                Case evtNumber:      castToSql = iItems
                Case evtDate:        castToSql = format(iItems, "\#mm-dd-yyyy\#")
                Case evtDateTime:    castToSql = format(iItems, "\#mm-dd-yyyy hh:nn:ss\#")
                Case evtTime:        castToSql = format(iItems, "\#hh:nn:ss\#")
                Case evtBoolean:     castToSql = CStr(iItems)
                Case Else:           castToSql = """" & iItems & """"
            End Select
    End Select
End Function
 
'/**
' * Gibt den Tybellen/Feldnamen aus einem String zurück
' * @param  String          Name des Feldes
' * @return String
' */
Private Function getFieldName(ByVal iItems As String) As String
    If Not rxIsName.test(iItems) Then Err.Raise vbObjectError, "getFieldName", "invalid fieldName"
    Dim replS As String: replS = "[$4$5]"
    If rxIsName.execute(iItems)(0).subMatches(2) <> Empty Then: replS = "[$1$2]$3[$4$5]"
    If paramWithNz Then replS = "NZ(" & replS & ")"
    getFieldName = rxIsName.Replace(iItems, replS)
End Function
 
'/**
' * ermittelt den FilterType, falls er nicht bereits definiert ist
' * @param  Varaint         Die Werte
' * @param  eFilterTypes     FilterType aus der Eingabe
' * @return eFilterTypes
' */
Private Function getFilterType(ByRef iItems2 As Variant, ByVal iFilterType As eFilterTypes) As eFilterTypes
    If Not iFilterType = eftAutomatic Then
        getFilterType = iFilterType:    Exit Function
    End If
 
    If IsArray(iItems2) Then
        Select Case UBound(iItems2)
            Case 0:     getFilterType = IIf(rxLike.test(iItems2(0)), eftEqLike, efteq)
            Case 1:     getFilterType = eftBetween
            Case Else:  getFilterType = eftIn
        End Select
    Else
        getFilterType = eftEqLike
    End If
End Function
 
'/**
' * Ermittelt den Datentype eines Values
' * @param  Variant     Wert
' * @return eValueTypes
' */
Private Function getValueType(ByRef iItem As Variant) As eValueTypes
    'Wenn der ValueType bereits fix gesetzt ist, muss nicht ermittelt werden
    If pFixValueType <> evtAutomatic Then
        getValueType = pFixValueType
        Exit Function
    End If
 
    'Fallse mehrere Items vorhanden sind
    If IsArray(iItem) Then
        Dim i As Long: For i = 0 To UBound(iItem)
            Dim vt As eValueTypes: vt = getValueType(iItem(i))
            'Schauen, welcher Typ höher gewichtet ist
            getValueType = greatest(vt, getValueType)
        Next i
        Exit Function
    End If
 
    'ein einzelnes Item prüfen
    getValueType = Switch( _
        IsNull(iItem), evtnull, _
        isEmpty(iItem), evtempty, _
        TypeName(iItem) = "Boolean", evtBoolean, _
        IsDate(iItem), evtDateTime, _
        IsNumeric(iItem), evtNumber, _
        True, evtAutomatic _
    )
 
    'Wenn nicht eindeutig zugeordnet werden kann
    If getValueType = evtAutomatic Then
        Dim itemS As String: itemS = Trim(UCase(NZ(iItem)))
        If paramEmptyAsNull And itemS = "" Then getValueType = evtnull
        If paramParseBooleanString And (itemS = "TRUE" Or itemS = "FALSE") Then getValueType = evtBoolean
        If paramParseNullText And itemS = "NULL" Then getValueType = evtnull
    End If
 
    'Im Zweifelsfall als String
    If getValueType = evtAutomatic Then: getValueType = evtString
 
End Function
 
'------------------------------------------------------
' -- Class Events
'------------------------------------------------------
Private Sub Class_Initialize()
    'Collection initialisieren
    Set pSubs = New Collection
End Sub
 
Private Sub Class_Terminate()
On Error Resume Next
    'Collection sauber abbauen
    Dim i As Long: For i = pSubs.Count To 1 Step -1
        Set pSubs(i + 1) = Nothing
        pSubs.remove i
    Next i
End Sub
'------------------------------------------------------
' -- Private Properties
'------------------------------------------------------
 
'/**
' * Parst Value, ob es ein LIKE sein soll
' * @return RegExp
' */
Private Property Get rxLike() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/[\?\*]/")
    Set rxLike = rx
End Property
 
'/**
' * Parst Feldnamen mit und ohne Tabellenprefix
' * Submatches:
' * 0, 1: Tabellenname/Alias ohne Quote. Es ist höchstens eines von beiden SubMatches gefüllt
' * 2:    Trennzeichen: Empty, Punkt oder !
' * 3, 4: Feldname/Alias ohne Quote. Es ist nur eines von beiden SubMatches gefüllt
' *
' * @return RegExp
' */
Private Property Get rxIsName() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/^(?:(?:\[([a-z][^\]]*)\]|([a-z][\w]*))([.!]))?(?:\[([a-z][^\]]*)\]|([a-z][\w]*))$/i")
    Set rxIsName = rx
End Property
 
'------------------------------------------------------
' -- Libraries
'------------------------------------------------------
 
'/**
' * Führt einen Bitvergleich (AND) durch
' * @param  Long
' * @param  Long
' * @return Boolean
' *
Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function
 
'/**
' * Entfernt ein Bitwert, falls dieser enthalten ist
' * @param  Long
' * @param  Long
' * @return Long
' *
Private Function subB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Long
    subB = iHaystack
    If andB(iHaystack, iNeedle) Then subB = subB - iNeedle
End Function
 
'/**
' * Fügt einen Bitwert hinzu, falls er noch nicht enthalten ist
' * @param  Long
' * @param  Long
' * @return Long
' *
Private Function addB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Long
    addB = iHaystack
    If Not andB(iHaystack, iNeedle) Then addB = addB + iNeedle
End Function
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
 
'/**
' * Gibt den Grössten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example greatest("Hallo Welt", 42, "Mister-X") -> Mister-X
'*/
Private Function greatest(ParamArray iItems() As Variant) As Variant
    greatest = iItems(UBound(iItems))
    Dim item As Variant: For Each item In iItems
        If NZ(item) > NZ(greatest) Then greatest = item
    Next item
End Function