Have all email addresses in one email using Outlook called from Access 03 and Bcc

[Ultraviolet47]

Hi all

I'm using Access and Outlook 03.


I found some code that works-sort of! I am looking to call up a query
in Access and all the email addresses returned in this query, put in
the bcc field of one email in Outlook.


At the mo, it finds the email addresses, but pops up one new message
for each email addresses and puts in the To field, e.g 100 emails=100
popped up messages!


Is there anyway to avoid this loop and use a query to put all email
addresses in one
messages bcc field?


Public Function SendEmail()


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 fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String


Set fso = New FileSystemObject


' First, we need to know the subject.
' We can't very well be sending around blank messages...


Subjectline$ = InputBox$("Please enter the subject line for this
mailing.", _
"We Need A Subject Line!")


' If there's no subject, call it a day.


If Subjectline$ = "" Then
MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "E-Mail Merger"
Exit Function
End If


' Now we need to put something in our letter...


BodyFile$ = InputBox$("Please enter the filename of the body of the
message.", _
"We Need A Body!")


' If there's nothing to say, call it a day.


If BodyFile$ = "" Then
MsgBox "No body, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If


' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn't where you say it is. " & vbNewLine &
vbNewLine & _
"Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If


' Since we got a file, we can open it up.
Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False,
TristateUseDefault)


' and read it into a variable.
MyBodyText = MyBody.ReadAll


' and close the file.
MyBody.Close


' Now, we open Outlook for our own device..
Set MyOutlook = New Outlook.Application


' Set up the database and query connections


Set db = CurrentDb()


Set MailList = db.OpenRecordset("Qry_EmailrenewalsOE")


' now, this is the meat and potatoes.
' this is where we loop through our list of addresses,
' adding them to e-mails and sending them.


Do Until MailList.EOF


' This creates the e-mail


Set MyMail = MyOutlook.CreateItem(olMailItem)


' This addresses it
MyMail.Bcc = MailList("Email")


'This gives it a subject
MyMail.Subject = Subjectline$


'This gives it the body
MyMail.Body = MyBodyText


' This sends it!


'MyMail.Send


MyMail.Display


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


Loop


'Cleanup after ourselves


Set MyMail = Nothing


'Uncomment the next line if you want Outlook to shut down when its
done.
'Otherwise, it will stay running.


'MyOutlook.Quit
Set MyOutlook = Nothing


MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing


End Function


Thanks guys!

 

[Sue Mosher [MVP-Outlook]]

The loop is doing exactly what you asked -- creating a new email message for each record. If you want just one message, you should use the loop only to build a string with the addresses in it. Creation of the message should take place after the loop completes.

FWIW, the system you have now is actually better, with the exception that the address should go in To, not Bcc. An individual message is more likely to clear any spam filter than a Bcc bulk message.

FYI, there is a newsgroup specifically for general Outlook programming issues "down the hall" at microsoft.public.outlook.program_vba or, via web interface, at http://www.microsoft.com/office/community/en-us/default.mspx?dg=microsoft.public.outlook.program_vba

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers