Private Sub cbo________NotInList(strNewData As String, intResponse As Integer)
'Set Limit to List to Yes
'Created by Helen Feddema 7-Apr-2010
'Last modified 7-Apr-2010
'See Add-to Combo Boxes (AA 161).mdb
On Error GoTo ErrorHandler
Dim cbo As Access.ComboBox
Dim dbs As DAO.Database
Dim intMsgDialog As Integer
Dim intResult As Integer
Dim rst As DAO.Recordset
Dim strEntry As String
Dim strFieldName As String
Dim strMsg As String
Dim strMsg1 As String
Dim strMsg2 As String
Dim strTable As String
Dim strTitle As String
'The name of the table that is the combo box's row source
strTable = "________________"
'The type of item to add to the table
strEntry = "_____________"
'The field in the lookup table in which the new entry is stored
strFieldName = "_______________"
'The add-to combo box
Set cbo = Me.ActiveControl
'Display a message box asking whether the user wants to add
'a new entry.
strTitle = strEntry & " not in list"
intMsgDialog = vbYesNo + vbExclamation + vbDefaultButton1
strMsg1 = "Do you want to add "
strMsg2 = " as a new " & strEntry & " entry?"
strMsg = strMsg1 + strNewData + strMsg2
intResult = MsgBox(strMsg, intMsgDialog, strTitle)
If intResult = vbNo Then
'Cancel adding the new entry to the lookup table.
intResponse = acDataErrContinue
cbo.Undo
GoTo ErrorHandlerExit
ElseIf intResult = vbYes Then
'Add a new record to the lookup table.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
rst.AddNew
rst(strFieldName) = strNewData
rst.Update
rst.Close
'Continue without displaying default error message.
intResponse = acDataErrAdded
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
|