View Full Version : Auto email -


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?

gemma-the-husky
09-12-2008, 02:17 AM
re-read your post

after you open the reciprst recordset, you dont have an active record

you probably need

reciprst.movefirst to get to the first record

you may also need to allow for an empty recordset.

--------
not exactly sure but rather than using this record set, you may be able to just look up the value for the required master record
with something similar to

useemail = dlookup("email","tblcupids","cupid = " & mycupidid)

Jemmo
09-12-2008, 02:37 AM
Thankyou.
That's moved the code on a bit.

I guess half the battle with coding is knowing the best command for the job.

Thanks again - if I get any more issues I'll add a post.