Vba – Outlook VBA to create new draft email for each Contact Group in contact list

outlookvba

Is there a VBA script that will

  • Create a draft email for each Contact Group
  • With the Contact Group's contacts in the "TO" field
  • With a uniform Subject
  • With a uniform Body
  • …and bonus if the body includes the Signature

Background:
In my contact list I have about 50 Contact Groups, each representing a client, and each containing multiple contacts. Once a month, I must email an invoice to each client. This currently entails

  • creating an email for each of the 50 Contact Groups
  • copying a subject line to each of the 50 drafts
  • copying a body to each of the 50 drafts

I've found plenty of references for creating emails via VBA, but nothing about using Contact Groups to power it.

    Sub NewEmail()
    Dim myOutlook As Outlook.Application
    Dim objMailMessage As Outlook.MailItem
    Set myOutlook = Outlook.Application
    Set objMailMessage = myOutlook.CreateItem(0)
        With objMailMessage
            .To = "" '?
            .Subject = "Email subject"
            .Body = "Email body." 'Msg + Signature?
            .Display
            .Save
            .Close olPromptForSave
        End With
    End Sub

Best Solution

At the beginning of your code you need to add references to you 'Contact Group'. Let's assume you have one named 'Grupa Testowa' ('Testing group' in English). So, modify your code this way:

Sub NewEmail()
    'new part of the code here
    Dim CF As Folder
    Set CF = Application.Session.GetDefaultFolder(olFolderContacts)

    Dim DLI As DistListItem
    Set DLI = CF.items("Grupa Testowa")

    'your code here with one modification within With...End With
    With objMailMessage
        .To = DLI
    '...rest of your code
    End with
End sub

For further references check DistListItem Object description in MSDN.