G
Guest
The following throws a report into the body of an OUTLOOK 2003 email and it
worked the other day, however though data exists for some the code stops with
a debug error on the OutputTo line.
When I remove the "OnNoData" Cancel=True event on the report the code runs
generating the email.
The code stalls on the first director (who happens to not have any data for
the specified day), when the "OnNoData" Event has Cancel=True.
I suspect I am missing an error handler somewhere or something to that
effect but have no clue at this point.
Private Sub Command25_Click()
Dim wdApp As Word.Application
Dim doc As Word.Document
Dim Report As MailItem
Dim Directors As ADODB.Recordset
Set Directors = New ADODB.Recordset
Directors.Open "tblDirectorsList", CurrentProject.Connection, adOpenStatic
Do Until Directors.EOF
[Forms]![frm_PIReporting].[txtDirector].Value = Directors![Name]
[Forms]![frm_PIReporting].[txtEmail].Value = Directors![E_Mail]
DoCmd.OutputTo acOutputReport, "rpt_FalloutByDate", acFormatRTF,
"S:\EmailReports\Fallouts.rtf"
Set wdApp = New Word.Application
Set doc = wdApp.Documents.Open("S:\EmailReports\Fallouts.rtf")
Set Report = doc.MailEnvelope.Item
Report.To = [Forms]![frm_PIReporting].[txtEmail]
Report.Subject = "Audit Failures"
Report.Save
strID = Report.EntryID
Set itm = Nothing
Set OL = CreateObject("Outlook.Application")
Set ns = OL.GetNamespace("MAPI")
Set theitem = ns.GetItemFromID(strID)
If Not theitem Is Nothing Then
theitem.Forward.Display
theitem.Delete
End If
wdApp.Quit False
Set doc = Nothing
Set wdApp = Nothing
On Error Resume Next
Directors.MoveNext
Loop
End Sub
Could some offer a solution please?
Thanks
worked the other day, however though data exists for some the code stops with
a debug error on the OutputTo line.
When I remove the "OnNoData" Cancel=True event on the report the code runs
generating the email.
The code stalls on the first director (who happens to not have any data for
the specified day), when the "OnNoData" Event has Cancel=True.
I suspect I am missing an error handler somewhere or something to that
effect but have no clue at this point.
Private Sub Command25_Click()
Dim wdApp As Word.Application
Dim doc As Word.Document
Dim Report As MailItem
Dim Directors As ADODB.Recordset
Set Directors = New ADODB.Recordset
Directors.Open "tblDirectorsList", CurrentProject.Connection, adOpenStatic
Do Until Directors.EOF
[Forms]![frm_PIReporting].[txtDirector].Value = Directors![Name]
[Forms]![frm_PIReporting].[txtEmail].Value = Directors![E_Mail]
DoCmd.OutputTo acOutputReport, "rpt_FalloutByDate", acFormatRTF,
"S:\EmailReports\Fallouts.rtf"
Set wdApp = New Word.Application
Set doc = wdApp.Documents.Open("S:\EmailReports\Fallouts.rtf")
Set Report = doc.MailEnvelope.Item
Report.To = [Forms]![frm_PIReporting].[txtEmail]
Report.Subject = "Audit Failures"
Report.Save
strID = Report.EntryID
Set itm = Nothing
Set OL = CreateObject("Outlook.Application")
Set ns = OL.GetNamespace("MAPI")
Set theitem = ns.GetItemFromID(strID)
If Not theitem Is Nothing Then
theitem.Forward.Display
theitem.Delete
End If
wdApp.Quit False
Set doc = Nothing
Set wdApp = Nothing
On Error Resume Next
Directors.MoveNext
Loop
End Sub
Could some offer a solution please?
Thanks