Private Sub cboCategory_NotInList(NewData As String, Response As Integer)
' check for a numeric entry
If IsNumeric(NewData) Then
' check whether a category exists with that number
If IsNull(DLookup("ID", "Categories", "ID=" & NewData)) Then
' failure: display a custom message
MsgBox "This Category doesn't exist"
Response = acDataErrContinue
Else
' success: write a special temporary row source
cboCategory.RowSourceType = "Value List"
cboCategory.RowSource = NewData & ";" & NewData
Response = acDataErrAdded
End If
End If
End Sub
Private Sub cboCategory_AfterUpdate()
' if the combo was modified, reset it:
If cboCategory.RowSourceType = "Value List" Then
cboCategory.RowSourceType = "Table/Query"
cboCategory.RowSource = "Categories"
End If
End Sub
Private Sub cboEmployee_NotInList(NewData As String, Response As Integer)
Dim recTemp As DAO.Recordset
Dim strSQL As String
If IsNumeric(NewData) Then
' for a numeric entry, try to find that employee number
If IsNull(DLookup("ID", "Employees", "ID = " & NewData)) Then
' failure: display a custom error message
MsgBox "There is no employee with that number"
Response = acDataErrContinue
Else
' success: build a dummy recordset with one single record
' (both columns simply contain the employee number)
strSQL = "SELECT " & NewData & "," & NewData
Set recTemp = CurrentDb.OpenRecordset(strSQL)
Set cboEmployee.Recordset = recTemp
Response = acDataErrAdded
End If
Else
' not numeric: assume it's a first name
' let's build a recordset of all matching employees
strSQL _
= " SELECT ID, FirstName" _
& " FROM Employees" _
& " WHERE FirstName = '" & NewData & "'"
Set recTemp = CurrentDb.OpenRecordset(strSQL)
If recTemp.RecordCount Then recTemp.MoveLast
' examine the returned records
Select Case recTemp.RecordCount
Case 0
' no match, the default message will be displayed
Exit Sub
Case 1
' single match, already added to the temporary recordset
Response = acDataErrAdded
Case Else
' multiple matches: the user will have to select one
' let's write a filtered query of employees
' (but no message is needed)
strSQL _
= " SELECT ID, FirstName+' '+LastName, ID" _
& " FROM Employees" _
& " WHERE FirstName = '" & NewData & "'" _
& " ORDER BY LastName"
Set recTemp = CurrentDb.OpenRecordset(strSQL)
Response = acDataErrContinue
End Select
' assign the temporary record to the combo
Set cboEmployee.Recordset = recTemp
End If
End Sub
Private Sub cboPays_NotInList(strNewData As String, intResponse As Integer)
'
' Attempt to resolve the entered data into a country name, or a list
' of country names
Dim strCrit As String
Dim strSQL As String
Dim rec As DAO.Recordset
' The user typed something else than a French country name:
' open a recordset on the source table and try to find a match.
Set rec = CurrentDb("Pays").OpenRecordset(dbOpenDynaset)
Do ' dummy loop
' key field search: ISO country code
If Len(strNewData) = 2 Then
strCrit = "ISO = " & QuoteSQL(strNewData)
rec.FindFirst strCrit
If Not rec.NoMatch Then
' select single record
strSQL = "SELECT ISO From Pays WHERE " & strCrit
Exit Do
End If
End If
' alternate full name search: English names
If Not strNewData Like "*[[*?]*" Then
' no wildcard was provided
strCrit = "English Like " & QuoteSQL(strNewData & "*")
rec.FindFirst strCrit
If Not rec.NoMatch Then
' select matching English names
strSQL _
= " SELECT ISO, English FROM Pays" _
& " WHERE " & strCrit _
& " ORDER BY English"
Exit Do
End If
End If
' full search in both languages
If strNewData Like "*[[*?]*" Then
' user entered wildcards
strCrit = QuoteSQL(strNewData)
Else
' provide wildcards
strCrit = QuoteSQL("*" & strNewData & "*")
End If
' select all matching names from both columns
strSQL _
= " SELECT ISO, Français" _
& " FROM Pays" _
& " WHERE Français Like " & strCrit _
& " UNION SELECT ISO, English" _
& " FROM Pays" _
& " WHERE English Like " & strCrit _
& " ORDER BY 2"
Loop While False
' At this point, we have a query in strSQL;
' let's open it and check the record count.
Set rec = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rec.RecordCount Then rec.MoveLast
Select Case rec.RecordCount
Case 0
' no match found; manage error condition
intResponse = acDataErrDisplay
' better, custom message:
MsgBox "CUSTOM ERROR MESSAGE:" _
& vbCr _
& vbCr & "Aucun pays trouvé pour le critère :" _
& vbCr & strCrit _
& vbCr & "Veuillez choisir un pays dans la liste."
intResponse = acDataErrContinue
' done here (combo's recordset untouched)
Exit Sub
Case 1
' auto-accept the single matching record
strSQL = "SELECT " & QuoteSQL(rec!ISO) & "," & QuoteSQL(strNewData)
Set rec = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
intResponse = acDataErrAdded
Case Else
' let the user pick one matching record
intResponse = acDataErrContinue
End Select
' temporarily change the combo's recordset
Set cboPays.Recordset = rec
mfReset = True
End Sub
Set cboPays.Recordset = Nothing
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (3)
Commented:
Author
Commented:Additional Demo File
There has been a question today about using the “smart combo” technique in a more traditional setting, namely the the addition of a new record from the “not in list” event.
The idea is that the user can type “Baggins, Bilbo” in the combo box and that this name is added to the list feeding the combo box. This is straightforward. However, the user might forget the space as in “Doe,John” or correct a typo in the dialogue box used to validate the new name. In both cases, the exact string entered in the combo will not match the new row added to the source.
This demo shows how to overcome the problem. If a new name is validated (if the user presses [OK] in the dialogue), the row source of the combo is rewritten so that whatever it currently contains is accepted and translated to the newly created record.
The user can basically just type “X” and tab out, fill in the last and first names in the dialogue box, and see the new name selected in the combo. This avoids many tedious checks for the programmer, and a few potential error messages for the user.
This demo file is in Access 2000 format, although it was developed in Access 2007.
Q-27776325.mdb
If you find it useful, please vote the article useful instead!
Markus G Fischer — (°v°)
Commented:
THANKS.