Create Distribution Lists from Email
December 28, 2009 @ 7:30 AM by JP • 157 views • 1 Comment »
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.
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.
' 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.
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Save money, use VBA
Next Post: Playing with Outlook AddressLists
Cool this what I was thinking about doing for some time. In outlook2000, this didn't work for me. I had to make a minor adjustment.
MsgRecips.Add MsgSender
With dl
.dlName = distListName
.AddMembers MsgRecips
' .AddMember MsgSender
.Close olSave
End With
Again, thanks for this code.