Create Distribution Lists from Email

This is the next post in the Save money, use VBA series.

Create Distribution List from Email

Do you find yourself writing emails to the same group of people? Need a way to quickly create a distribution list consisting of everyone already included in a current email?

Here's a function that might help. Just pass in the appropriate mailitem and the name of the distribution list you'd like to use, and it will create a new distribution list in your default Contacts folder.

Function CreateDistListFromEmail(msg As Outlook.MailItem, _
    distListName As String)
' creates dist list from email recipients & sender
' select or open one email and run CreateDL procedure
  Dim dl As Outlook.DistListItem
  Dim MsgRecips As Outlook.Recipients
  Dim MsgSender As Outlook.Recipient
  Dim dummyMsg As Outlook.MailItem

  ' get recipients & sender as Recipient objects
  Set MsgRecips = msg.Recipients

  ' create dummy reply to turn sender into Recipient
  Set dummyMsg = msg.Reply
  Set MsgSender = dummyMsg.Recipients.item(1)

  ' create blank dist list
  Set dl = GetOutlookApp.CreateItem(olDistributionListItem)

  ' add email recipients & sender to dist list
  With dl
    .dlName = distListName
    .AddMembers MsgRecips
    .AddMember MsgSender
    .Close olSave
  End With

End Function

Function GetOutlookApp() As Outlook.Application
' returns reference to native Outlook.Application object
  Set GetOutlookApp = Outlook.Application
End Function

The AddMembers Method lets us add multiple recipients in one go, so all we need to do is grab MailItem.Recipients and use that as the parameter for AddMembers. Calling the Close Method with olSave as the parameter saves us one line of code (instead of writing .Save and then .Close). Let's look at a sample method for calling this function.

Sample usage

The CreateDL function will check if an email message is selected or open. If so, the end user is prompted for a distribution list name. Then the custom function CreateDistListFromEmail is called and the user is informed that the distribution list was created. From then on, you can use the distribution list name in the To: field.

Sub CreateDL()
' attach this code to toolbar button
' either on a (Explorer) toolbar, or directly on a
' mail message (Inspector) toolbar
  On Error GoTo ErrorHandler

  Dim dlName As String
  Dim msg As Outlook.MailItem

  ' get currently open or selected message
  Set msg = GetMailItem

  If msg Is Nothing Then
    Call MsgBox("No email is selected or open. Cannot continue.")
    Exit Sub
  End If

  ' get display & autocomplete name for dist list
  dlName = InputBox("Name for the distribution list?")
  If Len(dlName) = 0 Then GoTo ProgramExit

  Call CreateDistListFromEmail(msg, dlName)

  ' comment this out if you don't want a msgbox
  Call MsgBox("The distribution list " & dlName & _
    " was created.", vbInformation)

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Function GetMailItem() As Outlook.MailItem
' returns reference to current mail item, either the one
' current selected in an Explorer, or the one currently open

  Select Case True

  Case IsExplorer(Application.ActiveWindow)

    If IsMail(ActiveExplorer.Selection.Item(1)) Then
      Set GetMailItem = ActiveExplorer.Selection.Item(1)
    End If

  Case IsInspector(Application.ActiveWindow)

    If IsMail(ActiveInspector.CurrentItem) Then
      Set GetMailItem = ActiveInspector.CurrentItem
    End If
  End Select

End Function

Function IsMail(itm As Object) As Boolean
  IsMail = (TypeName(itm) = "MailItem")
End Function

Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function

Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function

My advice is to add CreateDL to a toolbar, ideally in a MailItem Inspector.