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
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