Sending a group email

  • Thread starter Thread starter James Duart Maclaine
  • Start date Start date
J

James Duart Maclaine

Hi...

I have created an Access database in which various continuous forms contain
student contact details, (filtered according to their class times).

I would like to be able to add a button to each of these forms which would
send a group email (via outlook) to all email addresses (there is only one
per record) contained in the form.

Eg. If I wanted to send an email to all students in Tuesday Evening, I
would click on the button located on the Tuesday Evening form and a new
email message would be generated, with all the corresponding email addresses
populating the To: field.

I hope there is a way to do this, I'm only just beginning with VB, and it's
definitely beyond my capabilities.

Your help is greatly appreciated.

Regards,
Ben
 
Here is some code that will use your form's recordset to send your emails.
In order for it to work, you will need to set a reference to the Microsoft
Outlook Object Library and Microsoft DAO Object Library that is appropriate
to your version of Office.

Also note that if your version of Office is reasonably up to date, you will
see the Outlook Security Prompt (which warns you that a program is trying to
access Outlook) each time your program attempts to add a recipient to the
Recipients Object. This is normal and you may simply click 'Yes' each time
that occurs to allow the program to proceed. If you must automate the
process fully, then you will need to read up on how to work with or around
the Security prompts. Here is a link with more information:

http://www.slipstick.com/outlook/esecup.htm#autosec




Dim oApp As Outlook.Application
Dim objNewMail As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim db As Database
Dim rs As DAO.Recordset
'Set db = CurrentDb
'Set rs = db.OpenRecordset("qryEmail1", dbOpenDynaset)

Set rs = Me.RecordsetClone
Set oApp = New Outlook.Application

Set objNewMail = oApp.CreateItem(olMailItem)
With objNewMail
rs.MoveFirst
Do While Not rs.EOF
If Len(Trim(rs!Email)) > 0 Then
Set objOutlookRecip = .Recipients.Add(rs!Email)
objOutlookRecip.Type = olTo
End If
rs.MoveNext
Loop
.Subject = "Test subject"
.Body = "Your text message here."
' .Attachments = "Filename.xxxx"
.Save
.Send
End With

rs.Close
Set rs = Nothing
 
Back
Top