Add To Combo blues


Owen Wilson


I have a combo box (cboTo) that allows the user to select
a contact name based on a company name selected in a
previous combo box. That works great until the user
tries to add a new contact name. Then the program gets
stuck in a loop. I get a msgbox asking the user if they
want to add a new contact, that's ok, the correct form
pops up (Contact Append), the user adds the required info
and that data goes into the correct table. The user then
closes the "Contact Append" form and the original forms
appears with the new contact name in the correct place.
When the user tries to leave cboTo, a message box pops us
and asks, again, if the user wants to add the new name.
This will go on forever. If the user clicks No, the
second time the box appears, the new contact name goes
away and the new name is not a selection in cbTo. If the
user leaves that record, returns to it and re-enters the
Company name, the new contact will appear as a selection
in cboTo. I have "add to" combo boxes in several places
on various forms and they all work great, except this
one. This is the only one whose recordset is based on a
selection from another control, though.

Please help.



Private Sub cboTo_NotInList(strNewData As String,
intResponse As Integer)
On Error GoTo ErrorHandler

Dim intResult As Integer
Dim strTitle As String
Dim intMsgDialog As Integer
Dim strMsg1 As String
Dim strMsg2 As String
Dim strmsg As String
Dim cbo As Access.ComboBox
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strTable As String
Dim strEntry As String
Dim strFieldname As String

strTable = "Sub-Contractors List"
strEntry = "Contact Name"
strFieldname = "Contact"

Set cbo = Me![cboTo]

strTitle = strEntry & " not in list"
intMsgDialog = vbYesNo + vbExclamation + _
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
intResponse = acDataErrContinue
Exit Sub
ElseIf intResult = vbYes Then
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
rst(strFieldname) = strNewData

'Turn off "Item isn't on the list" error message
intResponse = acDataErrAdded

stDocName = "Contact Append"
stLinkCriteria = "[Contact]=" & "'" & Me!
[cboTo].Text & "'"
DoCmd.OpenForm stDocName, , , stLinkCriteria

End If

intResponse = acDataErrAdded
Exit Sub

MsgBox "Error No: " & Err.Number & "; Description: " _
& Err.Description
Resume ErrorHandlerExit
End Sub


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question