Suppose you have a list of companies you deal with, and each company has more than one contact. You want to send a customised email to each company based on entries in an Excel spreadsheet. You want each of the recipients to be in the ‘To:’ field of the email. You’re out of luck because a mail merge from Excel will only accept a single email address, even if you separate them with semicolons.

My solution is to create a local distribution list in Outlook for each company and send to the distribution list name – this will resolve to the multiple email addresses and the recipients will be able to see who else received the email.

Unfortunately, I had over 200 companies with between 2 and 9 contact addresses each. It would have been a huge job to create these distribution lists manually, and keeping them up to date would have been a headache too.

After some research, I found an Excel macro which was a great starting point and I was able to customise it to create the distribution lists for me.

Firstly, my spreadsheet containing the distribution list data looks like this:

The original macro was configured to generate a single distribution list and required the spreadsheet to be arranged vertically in two columns. I made a few changes and additions as follows:

' Create multiple Outlook distribution lists from Excel spreadsheet
' by Andy Younie http://www.planetmediocrity.com
' Heavily based on JP's code which can be found at
' http://www.jpsoftwaretech.com/automatically-update-outlook-distribution-lists-from-excel/

Const olDistributionListItem = 7
Const olFolderContacts = 10

Sub MaintainDistList()

Dim DNAME as String ' Distribution list name
Dim outlook As Object ' Outlook.Application
Dim contacts As Object ' Outlook.Items
Dim myDistList As Object ' Outlook.DistListItem
Dim newDistList As Object ' Outlook.DistListItem
Dim objRcpnt As Object ' Outlook.Recipient
Dim arrData() As Variant
Dim rng As Excel.Range
Dim numRows As Long
Dim numCols As Long
Dim i As Long
Dim x As Long ' Counter for groups

Set outlook = GetOutlookApp
Set contacts = GetItems(GetNS(outlook))

' Count how many groups there are in the list
numRows = ActiveSheet.Range("A1").CurrentRegion.Rows.Count

' Start loop to create distribution list for each group
For x = 3 To numRows 'First group is on line 3 of the spreadsheet

' Set DNAME to the group name in column A
DNAME = ActiveSheet.Cells(x, "A").Value

On Error Resume Next
Set myDistList = contacts.item(DNAME)
On Error GoTo 0

If Not myDistList Is Nothing Then
' delete it
myDistList.Delete
End If

' recreate it
Set newDistList = outlook.CreateItem(olDistributionListItem)

With newDistList
.DLName = DNAME
.body = DNAME
End With

' loop through worksheet and add each member to dist list
' assume active sheet
numCols = Activesheet.Cells(x, "A").CurrentRegion.Columns.count - 1

ReDim arrData(1 To 1, 1 To numCols)

' take Group Names out of range
Set rng = Activesheet.Range("A1").CurrentRegion.Offset(x - 1, 1).resize(1, numCols)
' put range into array
arrData = rng.value

' assume 1 row with a variable number of columns
For i = 1 To numCols
Set objRcpnt = outlook.Session.CreateRecipient(arrData(1, i))

objRcpnt.Resolve
newDistList.AddMember objRcpnt
Next i

newDistList.Save

' End loop to create distribution list for each group
Next x
End Sub

Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function

Function GetItems(olNS As Object) As Object
Set GetItems = olNS.GetDefaultFolder(olFolderContacts).items
End Function

Function GetNS(ByRef app As Object) As Object
Set GetNS = app.GetNamespace("MAPI")
End Function

So, where do you put the code to make it work? Open your spreadsheet in Excel, and go to View > Macros (or press Alt+F8) to bring up the Macros dialogue. Type a macro name (it doesn’t matter what name you use at this point) then click the ‘Create’ button. You are now in the VB editor. Delete the code which looks like:

Sub test()

End Sub

Now, paste in the code from above and close the editor window to get back to your spreadsheet.

Save your spreadsheet, then press Alt+F8 again, you should see a macro called ‘MaintainDistList’ – highlight it and click the ‘Run’ button.

You will be prompted to allow access to Outlook, accept that and flick to your contacts list in Outlook – you should see all the new distribution lists being created.

You will now be able to do a mail merge from a spreadsheet which contains your company names and the data you want to merge into your template document. The company name will resolve to the addresses in the distribution list which has the same name.

An example spreadsheet containing company information:

I hope this is useful to you, let me know in the comments how you get on!