NotInList

[MChrist]

I have a combo box that I'm trying to use select Prospect from my table. If
the prospect isn't in the list I want to add them on the fly, but I'm having
troubles getting it to work correctly. I have the combo box's LimitToList
Property set to Yes, and the following code in the form's module.

The problem is that the routine will prompt me correctly if I want to create
the new records which it does fine, but then it loops and prompts me again.
When I click No, I get an error stating the item wasn't in the list, and then
another error that simply state Record Not Found.

Can someone tell me what I'm doing wrong here.

Thank you

Mark

Private Sub cmbProspectID_AfterUpdate()

Dim rs As DAO.Recordset
Dim strSearchName As String

Set rs = Me.RecordsetClone
strSearchName = Str(Me!cmbProspectID)
rs.FindFirst "ProspectID = " & strSearchName
If rs.NoMatch Then
MsgBox "Record not found."
Else
Me.Bookmark = rs.Bookmark
End If

rs.Close

End Sub

Private Sub cmbProspectID_NotInList(NewData As String, Response As Integer)
On Error GoTo Err_Handler
'add new Prospect

Dim strMsg As String
Dim rst As DAO.Recordset
Dim db As DAO.Database

strMsg = NewData & " is not in the list of prospects." & vbCrLf & vbCrLf _
& "Do you wish to add them as a prospect?"

If MsgBox(strMsg, vbYesNo + vbQuestion, "New Prospect") = vbYes Then

Set db = CurrentDb()
Set rst = db.OpenRecordset("tCDM_Prospects")
rst.AddNew
rst("Name") = NewData
rst.Update
Response = acDataErrAdded
Me.Requery
rst.Close
db.Close

Else
Response = acDataErrDisplay
End If

Exit_Routine:

Exit Sub

Err_Handler:

strMsg = "The following error occurred adding the new prospect." & vbCrLf
& vbCrLf _
& Err.Number & " " & Err.Description

MsgBox strMsg, vbCritical, "Error Adding New Prospect"

End Sub

Private Sub Form_Current()

cmbProspectID = Me.ProspectID

End Sub

 

[Rob Oldfield]

Take a look at this:

http://www.mvps.org/access/forms/frm0015.htm