Sending e-mail through Access

[JMH022]

Hello all!

I have a database that I set up to send reports to specific e-mail recipients using this code:

‘Code for Microsoft Access – Send e-mail
DoCmd.SendObject acReport, "Report1", _
"RichTextFormat(*.rtf)", “recipient@recipientsemail.com”, "", "", Date & _
" Report”, _
"Attached is today’s report.", False, ""

I am curious to know if it is possible that when I send the reports, the e-mail is not saved to my Outlook 2000 ‘Sent Items’ folder. I have done this in Excel using code that I received from some helpful wizards on this board:

‘ Code for Microsoft Excel – Send e-mail – Delete from ‘Sent Items’ after sending
Sub SetRecipients()
Dim olApp As Object, olMail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
Set rngeAddresses = ActiveSheet.Range("Y3:Y7")
For Each rngeCell In rngeAddresses.Cells
strRecipients = strRecipients & ";" & rngeCell.Value
Next
'format e-mail
olMail.To = strRecipients
olMail.Attachments.Add ActiveWorkbook.FullName
olMail.Subject = Date & " Report"
olMail.Body = "Attached is today’s report"
olMail.DeleteAfterSubmit = True
olMail.Send
End Sub

Is there a way to adapt this code so it will work in Access?

 

[mdmilner]

The "Excel" code should work practically as-is with the exception that your routines for applying values to the methods just needs to be updated to match access.

There's an error in this line:
'strRecipients = strRecipients & ";" & rngeCell.Value
It will place a leading ; character ahead of all entries. Outlook probably forgives you for this and ignores it.

I've commented out the original lines and inserted new lines.
Make the SQL command (strSQL) more specific to match the data in your actual table.

Mike

Sub SetRecipients() 
Dim olApp As Object, olMail As Object 
'Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String 
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL as String

Set dbs = CurrentDb()

strSQL = "SELECT * FROM tblName"

Set olApp = CreateObject("Outlook.Application") 
Set olMail = olApp.CreateItem(olMailItem) 

'Set rngeAddresses = ActiveSheet.Range("Y3:Y7") 

Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

With rs
  Do Until rs.EOF
    strRecipients = strRecipients & .Fields(0).Value & ";" 
    .MoveNext
  Loop
  strRecipients = Left(strRecipients,len(strRecipients)-1)
End With

'For Each rngeCell In rngeAddresses.Cells 
'strRecipients = strRecipients & ";" & rngeCell.Value 
'Next 

'format e-mail 
olMail.To = strRecipients 
olMail.Attachments.Add ReportName
olMail.Subject = Date & " Report" 
olMail.Body = "Attached is today’s report" 
olMail.DeleteAfterSubmit = True 
olMail.Send 
End Sub