Multiple Emails via MS Access to BCC Recipients 1

[cneill]

Hi
I have been using this codes for some time to send to Recipients using the query
The list of emails getting added to the "TO" list
Some of the people in the list have said they now do not want other people to see their email, how can I modify this code so that the list created gets added to "BCC" not "TO"

Thanks for your help

Private Sub CommandSendEmails_Click()

DoCmd.SetWarnings False
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT TblEmailList.* FROM TblEmailList"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rs.RecordCount = 0
With rs
.MoveFirst
.Delete
.MoveNext
End With
Loop

DoCmd.OpenQuery "QryMyEmailAddresses"

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$ = "Information about Tai Chi"
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 TblEmailList.email FROM TblEmailList;"

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)


'And on to the next one...
rsemail.MoveNext

Loop
'This gives it a subject
myMail.BCC = strSQL
myMail.Subject = Subjectline$
myMail.SendUsingAccount = MyOutlook.Session.Accounts.Item(1)
myMail.Body = "Hi Everyone, " & Chr(13) & Chr(13) & "Enter your email text Here" & Chr(13) & Chr(13) & "Best Wishes" & Chr(13) & Chr(13) & "Dee"
myMail.Display

Set myMail = Nothing
Set MyOutlook = Nothing
DoCmd.SetWarnings True
rsemail.Close
db.Close
Set db = Nothing

Exit Sub

End Sub

 

[lameid]

Add a declaration for your e-mail list...

Dim strEmailList as string

Replace
myMail.Recipients.Add rsemail(0)

With
strEmailList = IIF(strEmailList <> "", strEmailList & "; "& rsemail(0), rsemail(0))

Replace
myMail.BCC = strSQL

With
myMail.BCC = strEmailList

 

[cneill]

Hi lameid

Fantastic works a treat
Thanks you very much

 

[strongm]

Here's a pared down version of your code with some cvhanges I'd make;

[blue]Public Sub ParedDown()
    Dim db As DAO.Database
    Dim strSQL As String
    Dim MyOutlook As Outlook.Application
    Dim mysql As String
    Dim rsemail As DAO.Recordset
    Dim myMail As Outlook.MailItem
    
    [COLOR=green]' Cleanup table[/color]
    Set db = CurrentDb()
    strSQL = "delete * FROM TblEmailList"
    db.Execute strSQL
    
    [COLOR=green]' Repopulate[/color]
    DoCmd.OpenQuery "QryMyEmailAddresses"

    DoCmd.SetWarnings False
    
    Set MyOutlook = CreateObject("Outlook.Application")
    
    mysql = "SELECT DISTINCT TblEmailList.email FROM TblEmailList"
    Set myMail = MyOutlook.CreateItem(olMailItem)
    Set rsemail = db.OpenRecordset(mysql)
    
    Do Until rsemail.EOF
        [COLOR=green]' this allows you to send one email to multiple BCC recipients[/color]
        With myMail.Recipients.Add(rsemail(0))
            .Type = olBCC [COLOR=green]' Turn each recipient into a BCC recipient[/color]
            .Resolve [COLOR=green]' make sure Outlook understands[/color]
        End With
        [COLOR=green]' And on to the next one...[/color]
        rsemail.MoveNext
    Loop
    
    [COLOR=green]' This gives it a subject[/color]
    myMail.Subject = "Information about Tai Chi"
    myMail.SendUsingAccount = MyOutlook.Session.Accounts.Item(1)
    myMail.Body = "Hi Everyone, " & Chr(13) & Chr(13) & "Enter your email text Here" & Chr(13) & Chr(13) & "Best Wishes" & Chr(13) & Chr(13) & "Dee"
    myMail.Display
    
    Set myMail = Nothing
    Set MyOutlook = Nothing
    DoCmd.SetWarnings True
    rsemail.Close
    db.Close
    Set db = Nothing
End Sub[/blue]

 

[dhookom]

strongm,

Thanks for using TGML above and beyond. The extra formatting of an alternative color for comments shows huge commitment to helping others by making the code readable. Plus all of this was a bonus since the question had already been marked as satisfied!

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[strongm]

>already been marked as satisfied!

Indeed, although setting BCC to a string is not considered best practice

https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem.bcc