VBA Express : Outlook - Send Mass Mail from a folder

Outlook

Send Mass Mail from a folder

Ease of Use

Easy

Version tested with

2010

Submitted by:

Paleo

Description:

This macro allow you to use a folder to store drafts with many recipients and then send individual messages to each one of them

Discussion:

Sometimes you have to send the same message to a lot of recipients and you would like to create the impression it was writen individually. Using this macro you can create a draft inserting all recipients separated by ";" in its "To" field, insert the subject and body text and them send it individualy to each and every one.

Code:

instructions for use

			Public Sub SepareDrafts() 
     
    Dim lDraftItem As Long 
    Dim myOutlook As Outlook.Application 
    Dim myNameSpace As Outlook.NameSpace 
    Dim myFolders As Outlook.Folders 
    Dim myDraftsFolder As Outlook.MAPIFolder 
    Dim objMailMessage As Outlook.MailItem 
    Dim emlBody, sendTo As String 
    Dim TOs 
     
    Set myOutlook = Outlook.Application 
    Set myNameSpace = myOutlook.GetNamespace("MAPI") 
    Set myFolders = myNameSpace.Folders 
    Set myDraftsFolder = myNameSpace.PickFolder 
     
    For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1 
        TOs = Split(myDraftsFolder.Items.Item(lDraftItem).To, ";") 
        For i = 0 To UBound(TOs) 
            Set objMailMessage = myOutlook.CreateItem(0) 
            With objMailMessage 
                .To = TOs(i) 
                .Body = myDraftsFolder.Items.Item(lDraftItem).Body 
                .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject 
                .Display 
                .Send 
            End With 
        Next 
    Next lDraftItem 
    Set myDraftsFolder = Nothing 
    Set myNameSpace = Nothing 
    Set myOutlook = Nothing 
     
End Sub

How to use:

Open Outlook
Open the VBE (Alt + F11)
From the VBE top menu: Insert | Module
Paste all of the code in the module that was created
Close the VBE
From the Outlook top menu: Tools | Macro | Macros...
Select SepareDrafts() and click Run

Test the code:

Create a new message with many recipients
Add a subject and text to its body
Save it to create a draft
Run the macro
You will be asked for a folder
Choose the Drafts folder
Check your sent messages and you will see a individual message to each recipient

Sample File:

Módulo1.zip 0.53KB

Approved by Jacob Hilderbrand

This entry has been viewed 21 times.