I have code that works well below getting email addresses from a query and sending it. However, I would like to make all the recipients Bcc. If anyone could suggest some tweaks to my code below, I would appreciate it:
Private Sub cmd_email_del_Click()
On Error GoTo error
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim MyBodyText As String
Dim rsemail As DAO.Recordset
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim mysql As String
Subjectline$ = "Communication from GPD Training Branch"
DoCmd.SetWarnings False
Set MyOutlook = New Outlook.Application
Set MyOutlook = CreateObject("Outlook.Application")
Set ns = MyOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
MyOutlook.Explorers.Add Folder
Set db = CurrentDb()
mysql = "SELECT DISTINCT tbl_employees.Email FROM (tbl_employees INNER JOIN tbl_employee_courses ON tbl_employees.E_ID = tbl_employee_courses.E_ID) INNER JOIN tbl_courses ON tbl_employee_courses.C_ID = tbl_courses.C_ID WHERE (((tbl_employee_courses.End_Date)<Now()) AND ((tbl_employee_courses.Status) Not In ('Completed','Canceled')));"
Set rsemail = db.OpenRecordset(mysql)
Set MyMail = MyOutlook.CreateItem(olMailItem)
Do Until rsemail.EOF
'this allows you to send one email to multiple recipients
MyMail.Recipients.Add rsemail(0)
'MyMail.To = rsemail(0) 'maillist("email")
'And on to the next one...
rsemail.MoveNext
Loop
'This gives it a subject
MyMail.Subject = Subjectline$
MyMail.Body = "Hello, " & Chr(13) & Chr(13) & "You are receiving this email because our records indicate you may have completed a course and have yet to submit your course certificate." & Chr(13) & Chr(13) & "Thank You"
MyMail.Display
Set MyMail = Nothing
Set MyOutlook = Nothing
DoCmd.SetWarnings True
rsemail.Close
db.Close
Set db = Nothing
Exit Sub
error:
Call globalerrorhandler
Private Sub cmd_email_del_Click()
On Error GoTo error
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim MyBodyText As String
Dim rsemail As DAO.Recordset
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim mysql As String
Subjectline$ = "Communication from GPD Training Branch"
DoCmd.SetWarnings False
Set MyOutlook = New Outlook.Application
Set MyOutlook = CreateObject("Outlook.Application")
Set ns = MyOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
MyOutlook.Explorers.Add Folder
Set db = CurrentDb()
mysql = "SELECT DISTINCT tbl_employees.Email FROM (tbl_employees INNER JOIN tbl_employee_courses ON tbl_employees.E_ID = tbl_employee_courses.E_ID) INNER JOIN tbl_courses ON tbl_employee_courses.C_ID = tbl_courses.C_ID WHERE (((tbl_employee_courses.End_Date)<Now()) AND ((tbl_employee_courses.Status) Not In ('Completed','Canceled')));"
Set rsemail = db.OpenRecordset(mysql)
Set MyMail = MyOutlook.CreateItem(olMailItem)
Do Until rsemail.EOF
'this allows you to send one email to multiple recipients
MyMail.Recipients.Add rsemail(0)
'MyMail.To = rsemail(0) 'maillist("email")
'And on to the next one...
rsemail.MoveNext
Loop
'This gives it a subject
MyMail.Subject = Subjectline$
MyMail.Body = "Hello, " & Chr(13) & Chr(13) & "You are receiving this email because our records indicate you may have completed a course and have yet to submit your course certificate." & Chr(13) & Chr(13) & "Thank You"
MyMail.Display
Set MyMail = Nothing
Set MyOutlook = Nothing
DoCmd.SetWarnings True
rsemail.Close
db.Close
Set db = Nothing
Exit Sub
error:
Call globalerrorhandler