Another Error Handling Problem

D

Darb

Thanks for taking the time to read my question.

I have a sub that collects info puts it into a report,
then e-mails it, then finds the next record in the record
set, creates the report based on that criteria, e-mails
the report until Recordset.EOF If I close the e-mail
message without sending it, I get an error, which I can
catch the first time. The code continues to run well.
Then I close the second e-mail message, and I get a
message box with the error number and message. It is the
same err.number that I have programmed for and caught the
first time. Why dosesn't it catch it subsequent times?

does the err need to be reset?

Darb

all undeclaired variables are global

Private Sub cmdWklyInspRpt_Click()
Dim dbs As Database, rst As Recordset, rst1 As Recordset,
rst2 As Recordset
Dim ServRepEMail As String
Dim x As Integer, y As Integer, e As Integer
Dim PeopleNotEmailed As String
Dim KeepSending As String

On Error GoTo ErrorLine

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEMailTo")
rst.MoveFirst
Do Until rst.EOF

x = 0
y = 0
e = 0
ServRepName = rst![EMailToServiceRep]
ServRepEMail = rst![EMailAddress]

Set rst1 = dbs.OpenRecordset("SELECT
tblEMailTo.EMailToServiceRep, tblEMailTo.EMailAddress,
tblEMailToDetail.EMailToSowBarnName,
tblEMailToDetail.EMailToNurseryBarnName " & _
"FROM tblEMailTo
INNER JOIN tblEMailToDetail ON tblEMailTo.EMailToID =
tblEMailToDetail.EMailToIDInEMailToDetail " & _
"Where
tblEMailTo.EMailToServiceRep = '" & ServRepName & "' AND
(tblEMailToDetail.EMailToNURSERYBarnName) IS NOT NULL;",
dbOpenForwardOnly)

Set rst2 = dbs.OpenRecordset("SELECT
tblEMailTo.EMailToServiceRep, tblEMailTo.EMailAddress,
tblEMailToDetail.EMailToSowBarnName,
tblEMailToDetail.EMailToNurseryBarnName " & _
"FROM tblEMailTo
INNER JOIN tblEMailToDetail ON tblEMailTo.EMailToID =
tblEMailToDetail.EMailToIDInEMailToDetail " & _
"Where
tblEMailTo.EMailToServiceRep = '" & ServRepName & "' AND
(tblEMailToDetail.EMailToSOWBarnName) IS NOT NULL;",
dbOpenForwardOnly)

e = 1
If Not rst.EOF Then rst.MoveFirst
Do Until rst1.EOF
x = x + 1
rst1.MoveNext
Loop
MsgBox x & " Nursery farms were chosen."

e = 2
If Not rst.EOF Then rst.MoveFirst
Do Until rst2.EOF
y = y + 1
rst2.MoveNext
Loop
MsgBox y & " Sow farms were chosen."

If x > 0 And y > 0 Then
'Filter for Reports. Don't erase this.
It doesn't affect the code, but you can paste this into
the filter line if it ever gets erased in the propeties.
'"EMailToServiceRep = '" & ServRepName
& "'"
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportNURSERY",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportSOW",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
Else
If x > 0 And y = 0 Then
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportNURSERY",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
End If
If y > 0 And x = 0 Then
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportSOW",
acFormatHTML, ServRepEMail, , , "Easywean Inspection
Forms Report: " & Me.StartDate & " To " & Me.EndDate
End If
End If

If x = 0 And y = 0 Then
If PeopleNotEmailed = "" Then
PeopleNotEmailed = ServRepName
Else
PeopleNotEmailed = PeopleNotEmailed
& ", " & ServRepName
End If
End If
GetBackToStart:
rst.MoveNext
Loop

If Not IsNull(PeopleNotEmailed) Then
MsgBox PeopleNotEmailed & " were not sent a report."
& Chr(13) & Chr(13) & " You may want to check the records
for the time period the report was based on to make sure
these people were not supposed to receive a report.", 48
End If

rst.Close
Set rst = Nothing
Set dbs = Nothing

ResumeFromError:
OpenSmall = False
Exit Sub

ErrorLine: 'This works the first time but fails there
after
If Err.Number = 2501 Then
KeepSending = MsgBox("You have stopped sending the
report. Do you want to continue to send the rest of the
reports?", 36)
If KeepSending = vbYes Then
GoTo GetBackToStart
Else
MsgBox "You have halted this procedure.
Click the 'Wkly Insp Rpt' button to run the reports
again."
Exit Sub
End If
Else
MsgBox Err.Description
GoTo ResumeFromError
End If
End Sub
 
D

DARB

I HAVE JUST FIGURED IT OUT! Thanks for taking a look,

Darb
-----Original Message-----
Thanks for taking the time to read my question.

I have a sub that collects info puts it into a report,
then e-mails it, then finds the next record in the record
set, creates the report based on that criteria, e-mails
the report until Recordset.EOF If I close the e-mail
message without sending it, I get an error, which I can
catch the first time. The code continues to run well.
Then I close the second e-mail message, and I get a
message box with the error number and message. It is the
same err.number that I have programmed for and caught the
first time. Why dosesn't it catch it subsequent times?

does the err need to be reset?

Darb

all undeclaired variables are global

Private Sub cmdWklyInspRpt_Click()
Dim dbs As Database, rst As Recordset, rst1 As Recordset,
rst2 As Recordset
Dim ServRepEMail As String
Dim x As Integer, y As Integer, e As Integer
Dim PeopleNotEmailed As String
Dim KeepSending As String

On Error GoTo ErrorLine

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEMailTo")
rst.MoveFirst
Do Until rst.EOF

x = 0
y = 0
e = 0
ServRepName = rst![EMailToServiceRep]
ServRepEMail = rst![EMailAddress]

Set rst1 = dbs.OpenRecordset("SELECT
tblEMailTo.EMailToServiceRep, tblEMailTo.EMailAddress,
tblEMailToDetail.EMailToSowBarnName,
tblEMailToDetail.EMailToNurseryBarnName " & _
"FROM tblEMailTo
INNER JOIN tblEMailToDetail ON tblEMailTo.EMailToID =
tblEMailToDetail.EMailToIDInEMailToDetail " & _
"Where
tblEMailTo.EMailToServiceRep = '" & ServRepName & "' AND
(tblEMailToDetail.EMailToNURSERYBarnName) IS NOT NULL;",
dbOpenForwardOnly)

Set rst2 = dbs.OpenRecordset("SELECT
tblEMailTo.EMailToServiceRep, tblEMailTo.EMailAddress,
tblEMailToDetail.EMailToSowBarnName,
tblEMailToDetail.EMailToNurseryBarnName " & _
"FROM tblEMailTo
INNER JOIN tblEMailToDetail ON tblEMailTo.EMailToID =
tblEMailToDetail.EMailToIDInEMailToDetail " & _
"Where
tblEMailTo.EMailToServiceRep = '" & ServRepName & "' AND
(tblEMailToDetail.EMailToSOWBarnName) IS NOT NULL;",
dbOpenForwardOnly)

e = 1
If Not rst.EOF Then rst.MoveFirst
Do Until rst1.EOF
x = x + 1
rst1.MoveNext
Loop
MsgBox x & " Nursery farms were chosen."

e = 2
If Not rst.EOF Then rst.MoveFirst
Do Until rst2.EOF
y = y + 1
rst2.MoveNext
Loop
MsgBox y & " Sow farms were chosen."

If x > 0 And y > 0 Then
'Filter for Reports. Don't erase this.
It doesn't affect the code, but you can paste this into
the filter line if it ever gets erased in the propeties.
'"EMailToServiceRep = '" & ServRepName
& "'"
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportNURSERY",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportSOW",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
Else
If x > 0 And y = 0 Then
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportNURSERY",
acFormatRTF, ServRepEMail, , , "Easywean Inspection Forms
Report: " & Me.StartDate & " To " & Me.EndDate
End If
If y > 0 And x = 0 Then
OpenSmall = True

DoCmd.SendObject
acSendReport, "rptqryServRepWeeklyReportSOW",
acFormatHTML, ServRepEMail, , , "Easywean Inspection
Forms Report: " & Me.StartDate & " To " & Me.EndDate
End If
End If

If x = 0 And y = 0 Then
If PeopleNotEmailed = "" Then
PeopleNotEmailed = ServRepName
Else
PeopleNotEmailed = PeopleNotEmailed
& ", " & ServRepName
End If
End If
GetBackToStart:
rst.MoveNext
Loop

If Not IsNull(PeopleNotEmailed) Then
MsgBox PeopleNotEmailed & " were not sent a report."
& Chr(13) & Chr(13) & " You may want to check the records
for the time period the report was based on to make sure
these people were not supposed to receive a report.", 48
End If

rst.Close
Set rst = Nothing
Set dbs = Nothing

ResumeFromError:
OpenSmall = False
Exit Sub

ErrorLine: 'This works the first time but fails there
after
If Err.Number = 2501 Then
KeepSending = MsgBox("You have stopped sending the
report. Do you want to continue to send the rest of the
reports?", 36)
If KeepSending = vbYes Then
GoTo GetBackToStart
Else
MsgBox "You have halted this procedure.
Click the 'Wkly Insp Rpt' button to run the reports
again."
Exit Sub
End If
Else
MsgBox Err.Description
GoTo ResumeFromError
End If
End Sub


.
Click to expand...
 

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

Similar Threads

Invalid Operation on recordset.movefirst 3
Error Handling Problems 4
SendObject error 2
Excel hangs. Why? 1
REPOST: SendObject error (FAO: Basil) 4
help please...get values from recordset based on another recordset 1
Excel hangs 1
Error: an object cannot be found 2

Top