O
Owen Wilson
Hello,
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.
TIA
Owen
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 + _
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
intResponse = acDataErrContinue
cbo.Undo
Exit Sub
ElseIf intResult = vbYes Then
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
rst.AddNew
rst(strFieldname) = strNewData
rst.Update
rst.Close
'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
ErrorHandlerExit:
intResponse = acDataErrAdded
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " _
& Err.Description
Resume ErrorHandlerExit
End Sub
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.
TIA
Owen
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 + _
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
intResponse = acDataErrContinue
cbo.Undo
Exit Sub
ElseIf intResult = vbYes Then
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
rst.AddNew
rst(strFieldname) = strNewData
rst.Update
rst.Close
'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
ErrorHandlerExit:
intResponse = acDataErrAdded
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " _
& Err.Description
Resume ErrorHandlerExit
End Sub