Create Distribution Lists for your Contacts

I've been enjoying the series of posts called What is Normalization over at Roger's Access Blog. If you get a chance, check it out, it's really great reading.

Today I've chosen to demonstrate how to programmatically create distribution lists from Excel.

I won't bore you with an explanation of what distribution lists are, and why they are useful. For that, you can check out Microsoft Outlook and Exchange Distribution Lists.

Here is a simple function that can create a simple distribution list. It accepts two arguments: a comma-separated list of email addresses, and a name for your distribution list.

We'll use some of the same elements as with other Outlook automation code: a separate function to create an object reference to the Outlook.Application Object, and a module-level boolean variable to check if we started Outlook (and close it at the end of the function).

Dim bWeStartedOutlook As Boolean
Const olSave As Long = 0
Function CreateDistList(EmailAddresses As String, DistName As String) As Boolean
' create Outlook distribution list contact from Excel
' stored in default Contacts folder

' EmailAddresses: a comma-delimited string literal list of valid email addresses
' DistName: a string literal name for the distribution list

On Error GoTo ErrorHandler

Dim vAddr As Variant
vAddr = Split(EmailAddresses, ",")

' get Outlook
Dim olApp As Object ' Outlook.Application
Set olApp = GetOutlookApp

' create distribution list items
Dim olDistListItem As Object ' Outlook.DistListItem
Dim tempMailItem As Object ' Outlook.MailItem
Dim tempRecipients As Object ' Outlook.Recipients

Set olDistListItem = olApp.CreateItem(7) ' olDistributionListItem
olDistListItem.DLName = DistName

' create dummy mailitem to pass recipient object to DistListItem
Set tempMailItem = olApp.CreateItem(0) ' olMailItem
' Outlook Object Model Guard will be triggered here
Set tempRecipients = tempMailItem.Recipients

Dim i As Long
For i = 0 To UBound(vAddr)
  tempRecipients.Add(vAddr(i))
Next i

With olDistListItem
  .AddMembers tempRecipients
  .Close olSave
End With

' if we got this far, assume success
CreateDistList = True
GoTo ExitProc

ErrorHandler:
CreateDistList = False

ExitProc:
Set tempRecipients = Nothing
Set tempMailItem = Nothing
Set olDistListItem = Nothing
If bWeStartedOutlook Then
  olApp.Quit
End If
Set olApp = Nothing
End Function

Function GetOutlookApp() As Object
On Error Resume Next
  Set GetOutlookApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Set GetOutlookApp = CreateObject("Outlook.Application")
    bWeStartedOutlook = True
  End If
On Error GoTo 0
End Function

The Split function returns an array, so we assign it to a Variant. The DistListItem doesn't directly accept email addresses or names; we need to pass a Recipient Object to it. So we create a temporary mailitem, add some recipients, then add those recipients to the DistListItem.

Sample usage:

Sub test()
Dim success As Boolean
Dim str As String

str = "jsmith1@somewhere.com,jsmith2@somewhere.com"

success = CreateDistList(str, "My List")

End Sub

Since we're accessing the Recipients collection from outside Outlook, the OMG (Object Model Guard) will be triggered. If you use ClickYes, this shouldn't be too bothersome.

The reason we need to access the Recipients Collection is because Outlook's object model doesn't allow us to directly add members to the distribution list. We can only add Recipient Objects, which need to be created through a MailItem. First we need to create a temporary MailItem Object, add recipients to it, then copy those recipients over to the DistListItem Object.

The code is fully late bound, so no reference to Outlook's object library is required. I've listed the Outlook constants in comments next to each line of code, if you did want to change it to early bound.

A few additional notes on the code: The first argument must be a list of email addresses, comma separated and surrounded by double quotes. The second argument is the name of the distribution list as you want it to appear (i.e. "Friends").