Option Compare Database
Option Explicit
'Class Module Name: FindAsYouTypeListBox
'Purpose: Turn any Listbox into a "Find As You Type" listbox
'Created by: MajP
Private WithEvents mListbox As Access.ListBox
Private WithEvents mForm As Access.Form
Private WithEvents mSearchForm As Access.Form
Private WithEvents mTextBox As Access.TextBox
Private mFieldToSearch As String
Private mFilterFromStart As Boolean
Private mRsOriginalList As DAO.Recordset
Private Sub mTextBox_Change()
Call FilterList
End Sub
Private Sub mListBox_AfterUpdate()
Call unFilterList
mTextBox.SetFocus
mTextBox.Value = Null
End Sub
Private Sub mForm_Current()
Call unFilterList
End Sub
Private Sub FilterList()
On Error GoTo errLable
Dim rsTemp As DAO.Recordset
Dim strFilter As String
If Not Trim(mTextBox.Text & " ") = "" Then
strFilter = getFilter(mTextBox.Text)
Else
Call unFilterList
End If
Set rsTemp = mRsOriginalList.OpenRecordset
rsTemp.Filter = strFilter
Set rsTemp = rsTemp.OpenRecordset
If rsTemp.RecordCount > 0 Then
Set mListbox.Recordset = rsTemp
mListbox.Selected(0) = True
mListbox.Value = mListbox.Column(0)
Else
MsgBox "No records match " & strFilter
End If
mTextBox.SelStart = Len(mTextBox.Text)
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify Field Name is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Private Sub unFilterList()
On Error GoTo errLable
Set mListbox.Recordset = mRsOriginalList
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify Field Name is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Private Sub Class_Terminate()
Set mForm = Nothing
Set mListbox = Nothing
Set mRsOriginalList = Nothing
End Sub
Public Sub Initialize(theListBox As Access.ListBox, theTextBox As Access.TextBox, Optional FieldToSearch As String = "", Optional FilterFromStart = True)
On Error GoTo errLabel
If Not theListBox.RowSourceType = "Table/Query" Then
MsgBox "This class will only work with a ListBox that uses a Table or Query as the Rowsource"
Exit Sub
End If
Set mListbox = theListBox
Set mForm = theListBox.Parent
Set mTextBox = theTextBox
mFieldToSearch = FieldToSearch
mFilterFromStart = FilterFromStart
mForm.OnCurrent = "[Event Procedure]"
mTextBox.OnGotFocus = "[Event Procedure]"
mTextBox.OnChange = "[Event Procedure]"
mListbox.AfterUpdate = "[Event Procedure]"
Set mRsOriginalList = mListbox.Recordset.Clone
Exit Sub
errLabel:
MsgBox Err.Number & " " & Err.Description
End Sub
Private Function getFilter(theText As String) As String
'To make this work well convert all field in the listbox to string
'Example: strDateDue: cstr(dtmDueDate)
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim strFilter As String
Dim strLike As String
theText = Replace(theText, "'", "''")
If mFilterFromStart Then
strLike = " like '"
Else
strLike = " like '*"
End If
Set rs = mListbox.Recordset
If mFieldToSearch = "" Then
For Each fld In rs.Fields
If fld.Type = dbMemo Or fld.Type = dbText Then
If strFilter = "" Then
strFilter = fld.Name & strLike & theText & "*'"
Else
strFilter = strFilter & " OR " & fld.Name & strLike & theText & "*'"
End If
End If
Next fld
Else
strFilter = mFieldToSearch & strLike & theText & "*'"
End If
getFilter = strFilter
End Function
Public Property Get FilterFromStart() As Boolean
FilterFromStart = mFilterFromStart
End Property
Public Property Let FilterFromStart(ByVal blnFilterFromStart As Boolean)
mFilterFromStart = blnFilterFromStart
End Property
Public Property Get FieldToSearch() As String
FieldToSearch = mFieldToSearch
End Property
Public Property Let FieldToSearch(ByVal theFieldToSearch As String)
mFieldToSearch = theFieldToSearch
End Property
Public Sub SearchAllFields()
mFieldToSearch = ""
End Sub
Public Sub SortList(SortString As String)
Dim rs As DAO.Recordset
Set rs = mListbox.Recordset
rs.Sort = SortString
Set mListbox.Recordset = rs.OpenRecordset
Set rs = mRsOriginalList
rs.Sort = SortString
Set mRsOriginalList = rs.OpenRecordset
End Sub
