tinamiller1
06-11-2014, 01:43 PM
I have numerous tables, one of which is a Year_Table that is date/time for the YR datatype and I have YYYY in the format because that is all I want displayed on my forms. I have a filter function that is public that collects data from 11 listboxes and then when the click for results button is selected, it houses the filter information of what the user selected and displays in the details on a continous form. My problem is, I just changed the Year_Table and the filter is no longer working. It says when I click on the listbox selection of 2013 or 2014, datatype mismatch in criteria expression. I don't see where the problem is. Here is the code and maybe someone can see what I am missing here:
Option Compare Database
Option Explicit
Private Sub cmdReset_Click()
Dim ctrl As Access.Control
Dim itm As Variant
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
If ctrl.MultiSelect = 0 Then
ctrl = Null
Else
For Each itm In ctrl.ItemsSelected
ctrl.Selected(itm) = False
Next
End If
End If
Next ctrl
Me.Filter = ""
Me.FilterOn = False
End Sub
Private Sub cmdResults_Click()
Dim formfilter As String
formfilter = GetFilterFromListBoxes
Debug.Print formfilter
Me.FilterOn = False
Me.Filter = formfilter
Me.FilterOn = True
End Sub
Public Function GetFilterFromListBoxes() As String
Dim lst As Access.ListBox
Dim ctrl As Access.Control
Dim fieldName As String
Dim fieldType As String
Dim TotalFilter As String
Dim ListFilter As String
Dim itm As Variant
'Each listbox needs a tag property with the field name and the field type
'Seperate these with a ;
'The types are Text, Numeric, or Date
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
fieldName = Split(ctrl.tag, ";")(0)
fieldType = Split(ctrl.tag, ";")(1)
For Each itm In ctrl.ItemsSelected
If ListFilter = "" Then
ListFilter = GetProperType(ctrl.ItemData(itm), fieldType)
Else
ListFilter = ListFilter & "," & GetProperType(ctrl.ItemData(itm), fieldType)
End If
Next itm
If Not ListFilter = "" Then
ListFilter = fieldName & " IN (" & ListFilter & ")"
End If
If TotalFilter = "" And ListFilter <> "" Then
TotalFilter = ListFilter
ElseIf TotalFilter <> "" And ListFilter <> "" Then
TotalFilter = TotalFilter & " AND " & ListFilter
End If
ListFilter = ""
End If
Next ctrl
GetFilterFromListBoxes = TotalFilter
End Function
Public Function GetProperType(varitem As Variant, fieldType As String) As Variant
If fieldType = "Text" Then
GetProperType = sqlTxt(varitem)
ElseIf fieldType = "Date" Then
GetProperType = SQLDate(varitem)
Else
GetProperType = varitem
End If
End Function
Public Function sqlTxt(varitem As Variant) As Variant
If Not IsNull(varitem) Then
varitem = Replace(varitem, "'", "''")
sqlTxt = "'" & varitem & "'"
End If
End Function
Function SQLDate(varDate As Variant) As Variant
If IsDate(varDate) Then
If DateValue(varDate) = varDate Then
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
Else
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
End If
End If
End Function
Option Compare Database
Option Explicit
Private Sub cmdReset_Click()
Dim ctrl As Access.Control
Dim itm As Variant
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
If ctrl.MultiSelect = 0 Then
ctrl = Null
Else
For Each itm In ctrl.ItemsSelected
ctrl.Selected(itm) = False
Next
End If
End If
Next ctrl
Me.Filter = ""
Me.FilterOn = False
End Sub
Private Sub cmdResults_Click()
Dim formfilter As String
formfilter = GetFilterFromListBoxes
Debug.Print formfilter
Me.FilterOn = False
Me.Filter = formfilter
Me.FilterOn = True
End Sub
Public Function GetFilterFromListBoxes() As String
Dim lst As Access.ListBox
Dim ctrl As Access.Control
Dim fieldName As String
Dim fieldType As String
Dim TotalFilter As String
Dim ListFilter As String
Dim itm As Variant
'Each listbox needs a tag property with the field name and the field type
'Seperate these with a ;
'The types are Text, Numeric, or Date
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
fieldName = Split(ctrl.tag, ";")(0)
fieldType = Split(ctrl.tag, ";")(1)
For Each itm In ctrl.ItemsSelected
If ListFilter = "" Then
ListFilter = GetProperType(ctrl.ItemData(itm), fieldType)
Else
ListFilter = ListFilter & "," & GetProperType(ctrl.ItemData(itm), fieldType)
End If
Next itm
If Not ListFilter = "" Then
ListFilter = fieldName & " IN (" & ListFilter & ")"
End If
If TotalFilter = "" And ListFilter <> "" Then
TotalFilter = ListFilter
ElseIf TotalFilter <> "" And ListFilter <> "" Then
TotalFilter = TotalFilter & " AND " & ListFilter
End If
ListFilter = ""
End If
Next ctrl
GetFilterFromListBoxes = TotalFilter
End Function
Public Function GetProperType(varitem As Variant, fieldType As String) As Variant
If fieldType = "Text" Then
GetProperType = sqlTxt(varitem)
ElseIf fieldType = "Date" Then
GetProperType = SQLDate(varitem)
Else
GetProperType = varitem
End If
End Function
Public Function sqlTxt(varitem As Variant) As Variant
If Not IsNull(varitem) Then
varitem = Replace(varitem, "'", "''")
sqlTxt = "'" & varitem & "'"
End If
End Function
Function SQLDate(varDate As Variant) As Variant
If IsDate(varDate) Then
If DateValue(varDate) = varDate Then
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
Else
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
End If
End If
End Function