Tips - How to send thousands of newsletter using Excel file with Macro

There are several internet services that permit sending thousands of newsletter to huge destination contact list.

One of advantages are that receiving contacts would see email sent only to him and not in ccn. 

This result could be done easily in your own for free. Infact you should simply have a properly configured excel file (using macro) in conjunction with configured outlook program.

Before creating Excel macro you should read below article:

Here it is excel file appearance that you will get implementing following script. Obviously several enhancements and customizations could be done on script shown below.

You should prepare and Excel file with two sheets, one named "Email":
  • Here you should indicate Outlook email account from where newsletter are sents (Cell A2 - Be Aware to indicate uppercases correctly), Email Subject (Cell B2), Email text with indication (Cell C2) about new paragraphs, and attached file name indication (cell D2).
  • REMARK: Outlook signature image and attached file must be copied in C:\PEC folder.

About other Excel Sheet it should be named "Email_List":
  • On column A you should indicate destination Name and surname.
  • On Column B you must indicate destination email addresses.
  • On Column C Excel macro would indicate if newletter was sent succesfully.
  • Cell E2 you should indicate destination email numbers (indicated in Column B).
  • Send email button should be created and associated at below script:
Sub Invioemail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
    Dim strfrom, temp As String
    Dim oAccount As Object
    '  (a)
    Set OutApp = CreateObject("Outlook.Application")
    UR = 0      'email addressess destination numbers
    EmailAddr = ""
    EmailAddrFrom = ""                  'Outlook email account used to send email
    Subj = ""                           'Email Object
    BDT = ""                            'Email Text
    OutFile = ""                        'Attached file in C:\PEC and file name
    strfrom = ""
    UR = Sheets("Email_list").Range("E2").Value + 1                     'email addressess destination numbers indicated in .xls Email_list sheet and E2 cell
    EmailAddrFrom = Sheets("Email").Range("A2").Value                   'Outlook email account used to send email indicated in .xls Email sheet and A2 cell
    Subj = Sheets("Email").Range("B2").Value                            'Email Object indicated in .xls Email sheet and B2 cell
    BDT = "" & Sheets("Email").Range("C2").Value & "" 'Email text codified with Calibry font and size 11
    OutFile = "C:\PEC\" & Sheets("Email").Range("D2").Value             'Attached file located in C:\PEC, file name indicated in .xls sheet "email" and cell D2
    For I = 2 To UR   
        EmailAddr = ""  

        If I = 3 Then
            EmailAddr = Sheets("Email_list").Range("b" & I).Value & "; "
            EmailAddr = EmailAddr & Sheets("Email_list").Range("b" & I).Value & "; "
        End If
        Set OutMail = OutApp.CreateItem(0)                           'Here we create Email object
        strfrom = Sheets("Email").Range("a2").Value                  'Here we copy destination email addresses indicated in .xls sheet "email" and cell A2
        For Each oAccount In OutApp.Session.Accounts 
            If oAccount.DisplayName = strfrom Then 
                With OutMail
                    .To = EmailAddr
                    .CC = ""
                    .BCC = ""
                    .Subject = Subj
                    .Attachments.Add OutFile
                    .Attachments.Add "C:\PEC\Signature_1_00.png", olByValue, 0

'NOTE: I substituted minus and major sign wit - to avoid blog article publishing issues                    
                    .HTMLBody = BDT & "-br--br-" _
                            & "-img src='cid:Signature_1_00.png'" & "width='1' height='1'--br-" _
                            & "-br--/font--/span-"
' Signature image is indicated as Signature_1_00.png, width and height need to be indicated accordingly

                    Set .SendUsingAccount = oAccount
                    '.display ' it is useful if we would like to check email text filling up withouth sending it, .send command need
                    '==== above code is necessary to write on excel file email sent status, it could be improved
                    Sheets("Email_list").Range("c" & I).Value = ""
                    Sheets("Email_list").Range("c" & I).Value = "Mail sent succesfully"
                    End With
            End If
        '  (c)
    Next I
    Set OutMail = Nothing
    '  (d)
    Set OutApp = Nothing

        Application.Wait (Now + TimeValue("0:00:04"))
        Application.SendKeys "%a"
        Application.Wait (Now + TimeValue("0:00:04"))

    End Sub