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:
A | B | C | D | E | |
1 | Contact List | ||||
2 | Company Name | Contact 1 | Contact 2 | Contact 3 | Contact 4 |
3 | Acme Inc. | bob@acme.tld | fred@acme.tld | joe@acme.tld | john@acme.tld |
4 | Beta Co. | kevin@beta.tld | alice@beta.tld | tony@beta.tld | |
5 | Carrot Design | sheila@carrot.tld | colin@carrot.tld | gerry@carrot.tld | jen@carrot.tld |
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:
A | B | C | D | E | |
1 | Company Details | ||||
2 | Company Name | Value | Number of Orders | Renewal due | CEO Name |
3 | Acme Inc. | $20,135 | 23 | May 2013 | John Smith |
4 | Beta Co. | $13,998 | 12 | July 2013 | Carrie Jones |
5 | Carrot Design | $18,268 | 58 | January 2014 | Simon Brown |
I hope this is useful to you, let me know in the comments how you get on!