Option Compare Database
Option Explicit
'Class Module Name: FindAsYouTypeCombo
'Purpose: Turn any combobox into a "Find As You Type" 'Combobox
'Created by: MajP
'Demonstrates: OOP, and With Events
'
'Use: To use the class, you need a reference to DAO and code
'similar to the following in a form's module.
'Parmaters:
' TheComboBox: Your Combobox object passed as an object
' FilterFieldName: The name of the field to Filter as
' string
' FilterFromStart: Determines if you filter a field that
' starts with the text or if the text appears anywhere in
' the record.
'
'*******START: Form Code*******************
'
' Option Compare Database
' Option Explicit
' Public faytProducts As New FindAsYouTypeCombo
' Form_Open(Cancel As Integer)
' faytProducts.InitalizeFilterCombo Me.cmbProducts, ProductName", False
' End Sub
'
'******* END: Form Code ******************
Private WithEvents mCombo As Access.ComboBox
Private WithEvents mForm As Access.Form
Private mFilterFieldName As String
Private mRsOriginalList As DAO.Recordset
Private mFilterFromStart As Boolean
Public Property Get FilterComboBox() As Access.ComboBox
Set FilterComboBox = mCombo
End Property
Public Property Set FilterComboBox(TheComboBox As Access.ComboBox)
Set mCombo = TheComboBox
End Property
Private Sub mCombo_Change()
Call FilterList
End Sub
Private Sub mCombo_GotFocus()
mCombo.Dropdown
End Sub
Private Sub mCombo_AfterUpdate()
Call unFilterList
End Sub
Private Sub mForm_Current()
Call unFilterList
End Sub
Private Sub mForm_Close()
' Code provided by BenSacheri to keep Access from crashing
Call Class_Terminate
End Sub
Private Sub FilterList()
On Error GoTo errLable
Dim rsTemp As DAO.Recordset
Dim strText As String
Dim strFilter As String
strText = mCombo.Text
If mFilterFieldName = "" Then
MsgBox "Must Supply A FieldName Property to filter list."
Exit Sub
End If
If mFilterFromStart = True Then
strFilter = mFilterFieldName & " like '" & strText & "*'"
Else
strFilter = mFilterFieldName & " like '*" & strText & "*'"
End If
Set rsTemp = mRsOriginalList.OpenRecordset
rsTemp.Filter = strFilter
Set rsTemp = rsTemp.OpenRecordset
If rsTemp.RecordCount > 0 Then
Set mCombo.Recordset = rsTemp
End If
mCombo.Dropdown
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 mCombo.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_Initialize()
End Sub
Private Sub Class_Terminate()
Set mForm = Nothing
Set mCombo = Nothing
Set mRsOriginalList = Nothing
End Sub
Public Sub InitalizeFilterCombo(TheComboBox As Access.ComboBox, FilterFieldName As String, Optional FilterFromStart = True)
On Error GoTo errLabel
If Not TheComboBox.RowSourceType = "Table/Query" Then
MsgBox "This class will only work with a combobox that uses a Table or Query as the Rowsource"
Exit Sub
End If
Set mCombo = TheComboBox
Set mForm = TheComboBox.Parent
mFilterFieldName = FilterFieldName
mFilterFromStart = FilterFromStart
mForm.OnCurrent = "[Event Procedure]"
mCombo.OnGotFocus = "[Event Procedure]"
mCombo.OnChange = "[Event Procedure]"
mCombo.AfterUpdate = "[Event Procedure]"
mForm.OnClose = "[Event Procedure]"
With mCombo
.SetFocus
.AutoExpand = False
End With
Set mRsOriginalList = mCombo.Recordset.Clone
Exit Sub
errLabel:
MsgBox Err.Number & " " & Err.Description
End Sub
