Option Compare Database
Option Explicit
'Class Module Name: FindAsYouListBox
'Purpose: Turn any Listbox into a "Find As You Type" listbox
'Created by: MajP
'Demonstrates: OOP, and With Events
'
'Use:To use the class, you need code similar to the 'following in a form's module.
'Also requires a reference to DAO
'Two properties must be set: FilterListBox
'and FilterFieldName. These are the combo box object
'and the name of the field that you are filtering.
'
Private WithEvents mListbox As Access.ListBox
Private WithEvents mForm As Access.Form
Private WithEvents mTextBox As Access.TextBox
Private mFilterFieldName As String
Private mRsOriginalList As DAO.Recordset
Public Property Get FilterListBox() As Access.ListBox
Set FilterListBox = mListbox
End Property
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 strText As String
Dim strFilter As String
strText = mTextBox.Text
If mFilterFieldName = "" Then
MsgBox "Must Supply A FieldName Property to filter list."
Exit Sub
End If
strFilter = mFilterFieldName & " like '" & strText & "*'"
Set rsTemp = mRsOriginalList.OpenRecordset
rsTemp.Filter = strFilter
Set rsTemp = rsTemp.OpenRecordset
If rsTemp.RecordCount > 0 Then
Set mListbox.Recordset = rsTemp
End If
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
Public Property Get FilterFieldName() As String
FilterFieldName = mFilterFieldName
End Property
Public Property Let FilterFieldName(ByVal theFieldName As String)
mFilterFieldName = theFieldName
End Property
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, FieldName As String)
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
Me.FilterFieldName = FieldName
Set mListbox = theListBox
Set mForm = theListBox.Parent
Set mTextBox = theTextBox
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
