Replace 3200 error with custom error . . .

[Kurt]

I use the following sub routine and function to manage
the delete process. I like its flexibility over the
standard code provide by the wizard.
However, if the user tries to delete a record and cascade
delete is not permitted, I would like to replace the 3200
error, "The record cannot be deleted or changed because
table <name> includes related records," with a custom
error message.
I added the custom error to the ElseIf code of
Err_NotTrue, but when the user tries to delete a record
that would produce the 3200 error, instead of being
taking to the Err_NotTrue routine, he is instead taken
straight to the Function, asked if he wants to delete the
item, and then the record isn't deleted.

How can I edit the code so he's pointed to the custom
error?

Thanks. - Kurt

####

Private Sub cmdDelete_Click()

If Not (fDelCurrentRec(Me)) Then
On Error GoTo Err_NotTrue
End If

Exit_cmdDelete_Click:
Exit Sub
Err_NotTrue:
If Err.Number = 3218 Then ' Couldn't update;
currently locked error
Resume Exit_cmdDelete_Click
ElseIf Err.Number = 2501 Then ' User said no,
suppress error
Resume Exit_cmdDelete_Click
ElseIf Err.Number = 3200 Then ' Item in use;
cascade delete not allowed
MsgBox "This item cannot be deleted because it's
part of someone's record." & _
" " & Chr(13) & _
"If you would still like to delete it, you
first need to delete every instance of it currently in
use."
Resume Exit_cmdDelete_Click
Else
MsgBox "An error has occurred." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "cmdDelete_Click"
Resume Exit_cmdDelete_Click
End If

End Sub

''''''''''''''''''''''''''
BEGIN FUNCTION
''''''''''''''''''''''''''

Function fDelCurrentRec(ByRef frmCities As Form) As
Boolean
On Error GoTo Err_Section

Dim iresponse As Integer
iresponse = MsgBox("Are you sure you want to delete this
item?" & _
Chr(13) & Chr(13) & "Continue?", 4 + 32 +
256, "Confirm Delete")
If iresponse = 7 Then
Exit Function
Else
End If

With frmCities
If .NewRecord Then
.Undo
fDelCurrentRec = True
GoTo Exit_Section
End If
End With

With frmCities.RecordsetClone
.Bookmark = frmCities.Bookmark
.Delete
frmCities.Requery
End With
fDelCurrentRec = True
Exit_Section:
Exit Function

Err_Section:
fDelCurrentRec = False
Resume Exit_Section
End Function

 

[MacDermott]

Try making the On Error... statement the first statement after your Private
Sub ... declaration.

HTH
- Turtle

 

[Kurt]

Try making the On Error... statement the first

statement after your Private Sub ... declaration.

HTH
- Turtle

Not sure if I follow you. It sounds like you're
suggesting moving the "On Error GoTo Err_NotTrue" line to
immediately after "Private Sub cmdDelete_Click", but I
doubt that's what you're trying to say as that had no
effect. Can you be more specific?

Thanks.

 

[dan artuso]

Hi,
Your On Error... statement should almost always be the first statement after
your sub or function declaration.
In this case however, you have to trap the error (3200) in the form's Error event
with code like this:

If DataErr = 3200 Then
MsgBox "your blurb here"
Response = acDataErrContinue
End If

 

[Kurt]

Dan:

In this case however, you have to trap
the error (3200) in the form's Error event with
code like this:

If DataErr = 3200 Then
MsgBox "your blurb here"
Response = acDataErrContinue
End If

I tried this and it had no noticeable effect. It continues
to go straight to the function and iresponse (Are you sure
you want to delete this item?).

But I found a decent solution. Since the error should
occur in the function and not the sub, I changed the
Err_Section code of the *Function* from

. . .
Err_Section:
fDelCurrentRec = False
Resume Exit_Section
End Function

to . . .

Err_Section:
If Err.Number = 3200 Then ' Item in use...
MsgBox "blah blah blah"
fDelCurrentRec = False
Resume Exit_Section
End If
End Function

This does the trick.

Kurt