D
Dan
The following code (borrowed from www.functionx.com) has been adapted so I
may enter a new Agency in a field in a form if it is not in the tblagency.
Works great. However, if I select "No" in intAnswer the On Error GoTo runs
the Message "SomethingBadHappened" and I'm stuck. Is there a way that, if I
answer "No", give the user a chance to reenter a new Agency?
Thank you for any help!
Dan
-------------------------------------------------------------------
Private Sub agencyid_NotInList(NewData As String, Response As Integer)
On Error GoTo SomethingBadHappened
Dim rsttblagency As ADODB.Recordset
Dim intAnswer As Integer
intAnswer = MsgBox("Add " & NewData & " to the list of Agencies?", _
vbQuestion + vbYesNo)
If intAnswer = vbYes Then
Set rsttblagency = New ADODB.Recordset
rsttblagency.Open "tblAgency", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic, adCmdTable
rsttblagency.AddNew
rsttblagency!Agency = NewData
rsttblagency.Update
Response = acDataErrAdded
Else
Response = acDataErrDisplay
End If
rsttblagency.Close
Set rsttblagency = Nothing
Exit Sub
SomethingBadHappened:
MsgBox "When trying to process this order, something bad happened" & _
vbCrLf & "Please contact the program vendor and " & _
"report the error as follows" & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Resume Next
End Sub
may enter a new Agency in a field in a form if it is not in the tblagency.
Works great. However, if I select "No" in intAnswer the On Error GoTo runs
the Message "SomethingBadHappened" and I'm stuck. Is there a way that, if I
answer "No", give the user a chance to reenter a new Agency?
Thank you for any help!
Dan
-------------------------------------------------------------------
Private Sub agencyid_NotInList(NewData As String, Response As Integer)
On Error GoTo SomethingBadHappened
Dim rsttblagency As ADODB.Recordset
Dim intAnswer As Integer
intAnswer = MsgBox("Add " & NewData & " to the list of Agencies?", _
vbQuestion + vbYesNo)
If intAnswer = vbYes Then
Set rsttblagency = New ADODB.Recordset
rsttblagency.Open "tblAgency", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic, adCmdTable
rsttblagency.AddNew
rsttblagency!Agency = NewData
rsttblagency.Update
Response = acDataErrAdded
Else
Response = acDataErrDisplay
End If
rsttblagency.Close
Set rsttblagency = Nothing
Exit Sub
SomethingBadHappened:
MsgBox "When trying to process this order, something bad happened" & _
vbCrLf & "Please contact the program vendor and " & _
"report the error as follows" & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Resume Next
End Sub