When you create a new Contact Group (also known as a Distribution List), Outlook doesn’t offer you much flexibility when it comes to finding and selecting contacts via the “Add Members” dialog.
For instance, there is no way to quickly add several people belonging to the same company or Category to your Contact Group.
The VBA macro from this article allows you to select your members directly from your Contacts folder. This enables you to first sort or filter your Contacts folder by a specific field such by Company or Category and/or do a search query and thus select your contact group members more conveniently.
The AddContactsToDL macro allows you to directly create a add your currently selected contacts to a Contact Group. With this method you can bypass the inflexible “Add Members” dialog which doesn’t allow any filtering or sorting.
When executing the macro, you’ll be prompted to name your Contact Group. If you already have a Contact Group with that name, you’ll be asked if the macro should add the currently selected Contacts as members to the already existing Contact Group or if it should create a new one with the same name.
You can even quickly add selected contacts to an existing Contact Group.
Use the following instructions to configure the macro in Outlook;
- Download this code-file (
add2dl.zip) or copy the code below.
- Open the VBA Editor (keyboard shortcut ALT+F11)
- Extract the zip-file and import the
Add2DL.basfile via File-> Import…
If you copied the code, paste it into a new module.
- Sign your code so you won’t get any security prompts and the macro won’t get disabled.
- Add a button for easy access to the macro or press ALT+F8 and select the macro you want to execute.
Add a button to the Ribbon or the QAT to execute the Add2DL macro.
The following code is contained in the zip-file referenced in the Quick Install. You can use the code below for review or manual installation.
Public Sub AddContactsToDL() '================================================================= 'Description: Outlook macto to create a new contact group or ' update an existing one with the currently selected ' contact items. ' ' author : Robert Sparnaaij ' version: 1.0 ' website: https://www.howto-outlook.com/howto/addcontactstodl.htm '================================================================= Dim oDL As Outlook.DistListItem Dim oRecipients As Outlook.Recipients Dim oMail As Outlook.MailItem Dim objItemsCollection As Object Dim objItem As Object Dim oSelectedContact As Outlook.ContactItem Dim oSelectedDL As Outlook.DistListItem Dim oSelection As Outlook.Selection Dim CurrentFolder As Outlook.Folder Dim Result As Integer Dim Found As Boolean Dim strDisplayName As String Dim strDLName As String Set CurrentFolder = Application.ActiveExplorer.CurrentFolder If CurrentFolder.DefaultItemType <> olContactItem Then MsgBox "Please make your selection in a Contacts folder.", vbCritical, "Add Contacts to Contact Group" Exit Sub End If strDLName = InputBox("Please specify a name for your Contact Group:", _ "Contact Group Name") Set objItemsCollection = CurrentFolder.Items.Restrict("[FullName] = '" & strDLName & "'") Found = False If objItemsCollection.Count > 0 Then For Each objItem In objItemsCollection If objItem.Class = Outlook.olDistributionList Then Found = True Set oDL = objItem Exit For End If Next End If If Found = True Then Result = MsgBox("This Contact Group already exisits." & vbNewLine & _ "Would you like to add the selected members to this " & _ "Contact Group (Yes) or create it as a new " & _ "Contact Group (No)?", vbQuestion + vbYesNoCancel, "Contact Group already exisits") If Result = vbYes Then 'Nothing to do, we already set the oDL to the found object. ElseIf Result = vbNo Then Set oDL = Application.CreateItem(olDistributionListItem) oDL.DLName = strDLName Else Exit Sub End If Else Set oDL = Application.CreateItem(olDistributionListItem) oDL.DLName = strDLName End If Set oMail = Application.CreateItem(olMailItem) Set oRecipients = oMail.Recipients Set oSelection = Application.ActiveExplorer.Selection For Each objItem In oSelection If objItem.Class = Outlook.olContact Then Set oSelectedContact = objItem strDisplayName = oSelectedContact.Email1DisplayName If Len(strDisplayName) > 0 Then oRecipients.Add strDisplayName End If ElseIf objItem.Class = Outlook.olDistributionList Then Set oSelectedDL = objItem oRecipients.Add oSelectedDL.DLName End If Next oRecipients.ResolveAll oDL.AddMembers oRecipients oDL.DLName = strDLName oDL.Save Set CurrentFolder = Nothing Set objItemsCollection = Nothing Set oSelectedDL = Nothing Set oMail = Nothing Set oRecipients = Nothing Set oSelection = Nothing Set oSelectedContact = Nothing Set oDL = Nothing End Sub