Jemmo
09-12-2008, 02:00 AM
Hi folks.
I need some help here to point me to the error of my ways.
What I have been asked to do is have a button automatically email out reports (Excel spreadsheets) created by my database.
The database crunches data for a number of suppliers (Cupid's), data is inserted to a template, and saved as a unique (Cupid & date based) spreadsheet report.
What I am trying to do now is loop through the Cupids, and for each Cupid go to a directory path (where the reports are saved) and attach that Cupid's report to an email. The email recipient address is obtained via a table.
I have got the reports produced (thanks to some previous help here) and now am trying to get the email bit to work. So far so bad.
the code I have is;
Option Compare Database
Option Explicit
Public strTo As String
Public strCc As String
Public strBcc As String
Public strAttachment01 As String
Public strAttachment02 As String
Public strSubject As String
Public strBodyMessage As String
Public Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strFileExtension As String
Dim strSql As String
Dim strSql2 As String
Dim Cupidrst As DAO.Recordset
Dim Reciprst As DAO.Recordset
Dim StrCupid As String
Dim strFileName As String
Dim strRecipId As String
Dim strReportDate As String
DoCmd.Hourglass True
strReportDate = (Format(Now(), "ddmmyyyy")) 'Format the report date to today's date
strFileExtension = "_PBSE_DQ.xls" 'set the file extension to be '_PBSE_Await_Adopt.xls'
'SQL Statement to extract a list of Cupids
strSql = "SELECT DISTINCT [tblAllCupidPBSEStats].[CUPID]" & _
"FROM [tblAllCupidPBSEStats]"
'Set recordset Cupidrst to consist of the DISTINCT Cupids (in query sql1)
Set Cupidrst = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot, dbReadOnly)
Cupidrst.MoveFirst 'Go to the first Cupid in the list
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
'Email the PBSE Summary Stats Report to the appropriate Cupid
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
Do While Not Cupidrst.EOF
StrCupid = [Cupidrst]![Cupid]
'sets the filename to be the current Cupid's file (with the correct file extension
strFileName = StrCupid & "_" & strReportDate & strFileExtension
'get the email address (from a table) for the Cupid report being sent
strSql2 = "SELECT [tblCupid]![email]" & _
"FROM [tblCupid]" & _
"WHERE [tblCupid]![CUPID] = " & [Cupidrst]![Cupid]
Set Reciprst = CurrentDb.OpenRecordset(strSql2, dbOpenSnapshot, dbReadOnly)
'Set the recipients email address by referencing tblCupid (via [Reciprst])
strRecipId = [Reciprst]![email]
'Create the Outlook session
Set objOutlook = CreateObject("Outlook.Application")
'Create the message
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message
Set objOutlookRecip = .Recipints.Add(strRecipId)
objOutlookRecip.Type = olTo
'Set the Subject, Body and Importance of the message
.Subject = "PBSE Stats Summary Report"
.Body = "PBSE Stats Summary report attached"
.Importance = olImportanceNormal
'Add attachments to the message.
If Not IsMissing("D:\Databases\PBSE Data\DQ Data Queries\" & strFileName) Then
Set objOutlookAttach = .Attachments.Add("D:\Databases\PBSE Data\DQ Data Queries\" & strFileName)
End If
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Cupidrst.MoveNext
Loop
MsgBox "PBSE Summary Reports Complete!"
DoCmd.Hourglass False
'End If
End Sub
The code will step as far as;
'Set the recipients email address by referencing tblCupid (via [Reciprst])
strRecipId = [Reciprst]![email]
and then returns
Runtime error '3265';
Item not found in this collection
What am I doing wrong?
I need some help here to point me to the error of my ways.
What I have been asked to do is have a button automatically email out reports (Excel spreadsheets) created by my database.
The database crunches data for a number of suppliers (Cupid's), data is inserted to a template, and saved as a unique (Cupid & date based) spreadsheet report.
What I am trying to do now is loop through the Cupids, and for each Cupid go to a directory path (where the reports are saved) and attach that Cupid's report to an email. The email recipient address is obtained via a table.
I have got the reports produced (thanks to some previous help here) and now am trying to get the email bit to work. So far so bad.
the code I have is;
Option Compare Database
Option Explicit
Public strTo As String
Public strCc As String
Public strBcc As String
Public strAttachment01 As String
Public strAttachment02 As String
Public strSubject As String
Public strBodyMessage As String
Public Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strFileExtension As String
Dim strSql As String
Dim strSql2 As String
Dim Cupidrst As DAO.Recordset
Dim Reciprst As DAO.Recordset
Dim StrCupid As String
Dim strFileName As String
Dim strRecipId As String
Dim strReportDate As String
DoCmd.Hourglass True
strReportDate = (Format(Now(), "ddmmyyyy")) 'Format the report date to today's date
strFileExtension = "_PBSE_DQ.xls" 'set the file extension to be '_PBSE_Await_Adopt.xls'
'SQL Statement to extract a list of Cupids
strSql = "SELECT DISTINCT [tblAllCupidPBSEStats].[CUPID]" & _
"FROM [tblAllCupidPBSEStats]"
'Set recordset Cupidrst to consist of the DISTINCT Cupids (in query sql1)
Set Cupidrst = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot, dbReadOnly)
Cupidrst.MoveFirst 'Go to the first Cupid in the list
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
'Email the PBSE Summary Stats Report to the appropriate Cupid
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
Do While Not Cupidrst.EOF
StrCupid = [Cupidrst]![Cupid]
'sets the filename to be the current Cupid's file (with the correct file extension
strFileName = StrCupid & "_" & strReportDate & strFileExtension
'get the email address (from a table) for the Cupid report being sent
strSql2 = "SELECT [tblCupid]![email]" & _
"FROM [tblCupid]" & _
"WHERE [tblCupid]![CUPID] = " & [Cupidrst]![Cupid]
Set Reciprst = CurrentDb.OpenRecordset(strSql2, dbOpenSnapshot, dbReadOnly)
'Set the recipients email address by referencing tblCupid (via [Reciprst])
strRecipId = [Reciprst]![email]
'Create the Outlook session
Set objOutlook = CreateObject("Outlook.Application")
'Create the message
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message
Set objOutlookRecip = .Recipints.Add(strRecipId)
objOutlookRecip.Type = olTo
'Set the Subject, Body and Importance of the message
.Subject = "PBSE Stats Summary Report"
.Body = "PBSE Stats Summary report attached"
.Importance = olImportanceNormal
'Add attachments to the message.
If Not IsMissing("D:\Databases\PBSE Data\DQ Data Queries\" & strFileName) Then
Set objOutlookAttach = .Attachments.Add("D:\Databases\PBSE Data\DQ Data Queries\" & strFileName)
End If
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Cupidrst.MoveNext
Loop
MsgBox "PBSE Summary Reports Complete!"
DoCmd.Hourglass False
'End If
End Sub
The code will step as far as;
'Set the recipients email address by referencing tblCupid (via [Reciprst])
strRecipId = [Reciprst]![email]
and then returns
Runtime error '3265';
Item not found in this collection
What am I doing wrong?