Filteren op meerdere criteria

[JeroenMioch]

Beste mensen,

Ik heb een form waarin ik wil zoeken op meerdere criteria.
De records staan in een tabel genaamd TblCalamiteiten en ik wil kunnen filteren op :

Oorzaak (bijvoorbeeld Fraude, diefstal, verduistering etc etc)
Locatie (bijvoorbeeld Den Haag, Rotterdam, Amsterdam)
Incidentnummer

Bovenstaande lukt uiteraard maar waar ik op vast loop is dat ik ook wil kunnen filteren op:

van Datum tot Datum
van Bedrag tot bedrag

Dus, Als de gebruiker van de database bijvoorbeeld wil zien hoeveel gevalletjes fraude er zijn geweest van 1 januarie 2009 tot 1 januarie 2011 in "breda" van een waarde groter dan 1000 euri dan moeten die records die aan de criteria voldoen worden gefiltered.

Dit moet dan gebeuren middels een knop zoeken, de gebruiker vult de criteria in, drukt op zoeken en de database spuugt het er uit op het formulier.

Het lukt me dus niet om bedragen en de data te combineren met oorzaak, lokatie en incidentnummer.

Ik heb van alles geprobeerd om er zelf uit te komen, maar het wil me niet lukken

 

[JeroenMioch]

Oh dit is de code die ik tot nu toe heb, zoeken op datum doet nog even niet mee.

Private Sub KnpFilteren_Click()

    Dim strFilter As String
    Dim blnFilter As Boolean
    
    blnFilter = False
    
    strFilter = " 1=1 "
    If Me.FLDlokatieZoeken <> "" Then
        strFilter = strFilter + " and Lokatie like '*" & FLDlokatieZoeken & "*'"
        blnFilter = True
    End If
    
    If Me.FLDoorzaakZoeken <> "" Then
        strFilter = strFilter + " and Oorzaak like '*" & FLDoorzaakZoeken & "*'"
        blnFilter = True
    End If
    
    If Me.FLDincidentZoeken <> "" Then
        strFilter = strFilter + " and Incident like '*" & FLDincidentZoeken & "*'"
        blnFilter = True
    End If
    
    If Me.FLDbedragZoeken <> "" Then
        strFilter = strFilter + " and Bedrag > then " & FLDbedragZoeken & ""
        blnFilter = True
    End If
    
    If Me.FLDbedragZoeken2 <> "" Then
        strFilter = strFilter + " and Bedrag < then " & FLDbedragZoeken2 & ""
        blnFilter = True
    End If

    If blnFilter Then
        Me.Filter = strFilter
    Else
        Me.Filter = "1=2"
    End If
   
    Me.FilterOn = True
End Sub

 

[OctaFish]

Je hebt een foutje gemaakt in je code:

    If Me.FLDbedragZoeken <> "" Then
        strFilter = strFilter + " and [Totaalprijs] >  " & FLDbedragZoeken & ""
        blnFilter = True
    End If
    
    If Me.FLDbedragZoeken2 <> "" Then
        strFilter = strFilter + " and [Totaalprijs] < " & FLDbedragZoeken2 & ""
        blnFilter = True
    End If

 

[OctaFish]

En, om het verhaal af te maken: eeen complete routine inclusief werkend datumfilter....

Private Sub cmdFilteren_Click()
Dim strFilter As String, strWhere As String
Dim blnFilter As Boolean
Dim strDateField As String
Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Do NOT change it to match your local settings.
Dim tmp

    blnFilter = False
    strFilter = ""
    strDateField = "[Datum]"
    
    If Me.FLDlokatieZoeken <> "" Then
        strFilter = strFilter & "[Lokatie] LIKE '*" & Me.FLDlokatieZoeken.Value & "*'"
        blnFilter = True
    End If
    
    If Me.FLDbedragZoeken.Value <> "" And IsNumeric(Me.FLDbedragZoeken.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "[Totaalprijs] >  " & Me.FLDbedragZoeken.Value & ""
        blnFilter = True
    End If
    
    If Me.FLDbedragZoeken2.Value <> "" And IsNumeric(Me.FLDbedragZoeken2.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "[Totaalprijs] <  " & Me.FLDbedragZoeken2.Value & ""
        blnFilter = True
    End If

    If IsDate(Me.fldDatumZoeken.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "(" & strDateField & " >= " & Format(Me.fldDatumZoeken.Value, strcJetDate) & ")"
        blnFilter = True
    End If
    If IsDate(Me.fldDatumZoeken2.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "(" & strDateField & " < " & Format(Me.fldDatumZoeken2.Value + 1, strcJetDate) & ")"
        blnFilter = True
    End If

    If blnFilter Then
        Me.Filter = strFilter
        Me.FilterOn = True
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If
   
End Sub

 

[JeroenMioch]

Hey Michel

Ik ben pas Maandag weer op mn werk, en zal het dan gaan testen, maar ziet er prima uit.
Alvast bedankt en ik laat even weten of het allemaal werkt.

Het moeilijkste van de database komt nog, de gebruiker wil bijlages (Foto's, rapporten, faxen) kunnen toevoegen aan de records. Ik heb daar het één en ander over gelezen en daar ga ik een aardige kluif aan krijgen denk ik.

Groeten : Jeroen

 

[JeroenMioch]

Hey Michel,

Net even getest en werkt prima. Kan van je code ook weer wat leren
Nogmaals bedankt !

Ik zal de vraag even op opgelost zetten

 

[JeroenMioch]

Ohhh hellpppp

Ik heb geen idee waar het mis is gegaan, maar ik krijg ineens foutmeldingen. Als ik een waarde bij incidentnummer invoer in combinatie met de velden oorzaak en lokatie, krijg ik de foutmelding :

 Fout 3075 tijdens uitvoering:
Syntaxisfout (Operator ontbreekt) in query-expressie [SchadeBedrag] >=
1500 and [SchadeBedrag] <= 1500[Lokatie] LIKE '*openbare*'[Incidentnummer] LIKE
 '*PL-3453534*'.

Dit is mijn code :

Private Sub KnpFilteren_Click()

Dim strFilter As String, strWhere As String
Dim blnFilter As Boolean
Dim strDateField As String
Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Do NOT change it to match your local settings.
Dim tmp

blnFilter = False
    strFilter = ""
    strDateField = "[Datum]"
    
    If Me.FLDbedragZoeken.Value <> "" And IsNumeric(Me.FLDbedragZoeken.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "[SchadeBedrag] >=  " & Me.FLDbedragZoeken.Value & ""
        blnFilter = True
    End If

    If Me.FLDbedragZoeken2.Value <> "" And IsNumeric(Me.FLDbedragZoeken2.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "[SchadeBedrag] <=  " & Me.FLDbedragZoeken2.Value & ""
        blnFilter = True
    End If
    
    If IsDate(Me.FLDdatumZoeken.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "(" & strDateField & " >= " & Format(Me.FLDdatumZoeken.Value, strcJetDate) & ")"
        blnFilter = True
    End If

    If IsDate(Me.FLDdatumZoeken2.Value) Then
        If strFilter <> vbNullString Then strFilter = strFilter & " AND "
        strFilter = strFilter & "(" & strDateField & " <= " & Format(Me.FLDdatumZoeken2.Value + 1, strcJetDate) & ")"
        blnFilter = True
    End If
        
    If Me.FLDlokatieZoeken <> "" Then
        strFilter = strFilter & "[Lokatie] LIKE '*" & Me.FLDlokatieZoeken.Value & "*'"
        blnFilter = True
    End If
    
    If Me.FLDoorzaakZoeken <> "" Then
        strFilter = strFilter & "[oorzaak] LIKE '*" & Me.FLDoorzaakZoeken.Value & "*'"
        blnFilter = True
    End If
    
    If Me.FLDincidentZoeken <> "" Then
        strFilter = strFilter & "[Incidentnummer] LIKE '*" & Me.FLDincidentZoeken.Value & "*'"
        blnFilter = True
    End If

If blnFilter Then
        Me.Filter = strFilter
        Me.FilterOn = True
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If

    
End Sub

Ik zoek me helemaal een ongeluk waar ik de mist in gegaan ben ...Maar kan het echt niet vinden...

 

[OctaFish]

Je hebt een (behoorlijk belangrijke) regel weggelaten uit mijn code. Dat mag uiteraard, als je code daar beter van wordt. Zo niet: dan zou ik 'm toch weer terugzetten Je resultaat hoort er zo uit te zien:

[SchadeBedrag] >=1500 AND [SchadeBedrag] <= 1500 AND [Lokatie] LIKE '*openbare*' AND [Incidentnummer] LIKE  '*PL-3453534*'

Dat je iets anders produceert komt dus door het ontbreken van deze regel:

        If strFilter <> vbNullString Then strFilter = strFilter & " AND "

Moet ik nog een advies geven van wat je moet doen?

 

[JeroenMioch]

Ohhhh ja inderdaad, Het werkt nu wel

hulde voor Michel !!