So you have a list of emails and you want to keep in contact with folks easily.
I do this by periodically sending out emails to my former clients and offering them incentives to come back and purchase again. Since I already have their contact information in our Access Database for Invoicing, it makes sense to email them from here as well.
This is an example of an Access Database that interacts with Outlook using Automation and VBA Code.
On the right side, I’ve assigned my contacts and email sequence number:
On the left hand side I’ve created buttons for emailing groups of people based on their email sequence.
The drop down box with ‘Memorial Day Database Consulting Sale’ may be double clicked to open another screen for creating email messages:
When you’ve chosen the group of people to email (keep the groups small so you aren’ considered a spammer) and you’ve chosen your message, you may then email the group by choosing one of the ‘Mail to…’ buttons.
This is the code that runs behind the button to send the emails:
=fncSendEmail(1)
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strDate As String
Dim strAttachment As String
Set rs = CurrentDb.OpenRecordset(“select * from tblHospitalAssociations where EmailSequence = ” & pEmailSequence & ” and Email<>’Unknown'”)
rs.MoveLast
rs.MoveFirst
‘If rs.RecordCount > 3 Then Stop
Set objOutlook = CreateObject(“Outlook.Application”)
Do Until rs.EOF
‘Stop
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(rs![Email])
objOutlookRecip.Type = olTo
.Subject = txtSubject
.Body = txtMessage
If Not IsNull(txtAttachment) Then
strAttachment = txtAttachment
Set objOutlookAttach = .Attachments.Add(strAttachment)
End If ‘.Importance = olImportanceHigh ‘High importance
.Display
.Send
‘CurrentDb.Execute “INSERT INTO tbl_Email_History ( ClientID, EmailSentDate, EmailSubject, EmailBody ) ” & _
“SELECT ” & rs!ClientID & “, Date(), ‘” & txtSubject & “‘, ‘” & txtMessage & “‘”
rs.MoveNext
Loop
“WHERE EmailDate=#” & txtEmaildate & “#”
MsgBox “Done!”
End Function