Article ID: 161007
Article Last Modified on 1/19/2007
Private Sub CustomerID_NotInList (NewData As String, Response As _
Integer)
Dim Db As Database
Dim Rs As Recordset
Dim Msg As String
Dim NewID As String
On Error GoTo Err_CustomerID_NotInList
' Exit this subroutine if the combo box was cleared.
If NewData = "" Then Exit Sub
' Confirm that the user wants to add the new customer.
Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
' If the user chose not to add a customer, set the Response
' argument to suppress an error message and undo changes.
Response = acDataErrContinue
' Display a customized message.
MsgBox "Please try again."
Else
' If the user chose to add a new customer, open a recordset
' using the Customers table.
Set Db = CurrentDB
Set Rs = Db.OpenRecordset("Customers", DB_OPEN_TABLE)
' Ask the user to input a new Customer ID.
Msg = "Please enter a unique 5-character" & vbCr & "CustomerID."
NewID = InputBox(Msg)
Rs.FindFirst BuildCriteria("CustomerID", dbText, NewID)
' If the NewID already exists, ask for another new unique
' CustomerID
Do Until Rs.NoMatch
NewID = InputBox("Customer ID " & NewID & " already exists." & _
vbCr & vbCr & Msg, NewID & " Already Exists")
Rs.FindFirst BuildCriteria("CustomerID", dbText, NewID)
Loop
' Create a new record.
Rs.AddNew
' Assign the NewID to the CustomerID field.
Rs![CustomerID] = NewID
' Assign the NewData argument to the CompanyName field.
Rs![CompanyName] = NewData
' Save the record.
Rs.Update
' Set Response argument to indicate that new data is being added.
Response = acDataErrAdded
End if
Exit_CustomerID_NotInList:
Exit Sub
Err_CustomerID_NotInList:
'An unexpected error occurred, display the normal error message.
MsgBox Err.Description
'Set the Response argument to suppress an error message and undo
'changes.
Response = acDataErrContinue
End Sub
Private Sub CustomerID_NotInList (NewData As String, Response As _
Integer)
Dim Result
Dim Msg As String
Dim CR As String
CR = Chr$(13)
' Exit this subroutine if the combo box was cleared.
If NewData = "" Then Exit Sub
' Ask the user if he or she wishes to add the new customer.
Msg = "'" & NewData & "' is not in the list." & CR & CR
Msg = Msg & "Do you want to add it?"
If MsgBox(Msg, vbQuestion + vbYesNo) = vbYes Then
' If the user chose Yes, start the Customers form in data entry
' mode as a dialog form, passing the new company name in
' NewData to the OpenForm method's OpenArgs argument. The
' OpenArgs argument is used in Customer form's Form_Load event
' procedure.
DoCmd.OpenForm "Customers", , , , acAdd, acDialog, NewData
End If
' Look for the customer the user created in the Customers form.
Result = DLookup("[CompanyName]", "Customers", _
"[CompanyName]='" & NewData & "'")
If IsNull(Result) Then
' If the customer was not created, set the Response argument
' to suppress an error message and undo changes.
Response = acDataErrContinue
' Display a customized message.
MsgBox "Please try again!"
Else
' If the customer was created, set the Response argument to
' indicate that new data is being added.
Response = acDataErrAdded
End If
End Sub
Private Sub Form_Load ()
If Not IsNull(Me.OpenArgs) Then
' If form's OpenArgs property has a value, assign the contents
' of OpenArgs to the CompanyName field. OpenArgs will contain
' a company name if this form is opened using the OpenForm
' method with an OpenArgs argument, as done in the Orders
' form's CustomerID_NotInList event procedure.
Me![CompanyName] = Me.OpenArgs
End If
End Sub
Keywords: kbhowto kbprogramming kbusage KB161007