Integrating Access with Outlook using automation and vba (Visual Basic for Applications)

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:

Email Blast

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:

email blast message

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:


Function fncSendEmail(pEmailSequence As Integer) As Boolean
    Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strDate As String
Dim strAttachment As String
    Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset(“select * from tblHospitalAssociations where EmailSequence = ” & pEmailSequence & ” and Email<>’Unknown'”)

‘If rs.RecordCount > 3 Then Stop

Set objOutlook = CreateObject(“Outlook.Application”)

Do Until rs.EOF
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
‘CurrentDb.Execute “INSERT INTO tbl_Email_History ( ClientID, EmailSentDate, EmailSubject, EmailBody ) ” & _
“SELECT ” & rs!ClientID & “, Date(), ‘” & txtSubject & “‘, ‘” & txtMessage & “‘”

        End With


    CurrentDb.Execute “UPDATE tbl_Historical_Emails SET [” & pEmailSequence & “s] = True ” & _
“WHERE EmailDate=#” & txtEmaildate & “#”
MsgBox “Done!”
    fncSendEmail = True
End Function
This entry was posted in Uncategorized. Bookmark the permalink.