CODEWITHSUNDEEP
ms-accessvba
Ivan
Ivan

Reputation: 55

Send email to every contact in a table Access VBA

I have a column with mail addresses in a table with contacts in Access. I want to send an email to every contact in the table using a template which has signature, logo, and disclaimer. I managed to find a code for the template but I don't know how to send it to all contacts in the table. Here is my code: 

Sub sendmail()

Dim strEmail As String
Dim strSubject As String
Dim objOutlook As Object
Dim objMailItem As Object


Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)
Set objMailItem = objOutlook.CreateItemFromTemplate("C:\Users\user\AppData\Roaming\Microsoft\Templates\Template.oft")



strEmail = "[email protected]"
strSubject = "Test"
objMailItem.To = strEmail
objMailItem.Subject = strSubject



objMailItem.Display



End Sub

Any suggestions how to do it? Thanks

Upvotes: 2

Views: 3673

Answers (1)

Steve W
Steve W

Reputation: 476

set your strEmail variable to list all the email addresses in your table. You can do something like this:

Private Sub sendmail()

    Dim strEmail As String
    Dim strSubject As String
    Dim objOutlook As Object
    Dim objMailItem As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMailItem = objOutlook.CreateItem(olMailItem)
    Set objMailItem = objOutlook.CreateItemFromTemplate("C:\Users\user\AppData\Roaming\Microsoft\Templates\Template.oft")

    'set email addresses
    strEmail = "[email protected]"

    Dim rs As Recordset
    Dim sql As String
    Dim i As Integer

    sql = "SELECT fldEmailAddress FROM tblContacts"
    Set rs = CurrentDb.OpenRecordset(sql)

    With rs
        If Not .EOF And Not .BOF Then
            .MoveLast
            .MoveFirst

            For i = 0 To .RecordCount - 1
                If i = 0 Then
                    strEmail = !fldEmailAddress
                Else
                    strEmail = strEmail & "; " & !fldEmailAddress
                End If
                .MoveNext
            Next
        End If
    End With

    strSubject = "Test"
    objMailItem.to = strEmail
    objMailItem.Subject = strSubject

    objMailItem.Display
End Sub

Upvotes: 2

Related Questions