I'd like to quickly - with a click or two, assign a particular sender of email to a Contact Group.
You can use a macro to add the sender of a selected message to a Contact Group (aka distribution list or DL) in one click (ok, two, as you need to select the Contract group name too).
When you run this macro after selected an email message, it asks if you want to add to an existing contact group or create a new one.
If you choose to add it to an existing list, a list box containing the names of your existing Contact Groups displays. Double click on a name to add the email address to that list. If you said you wanted to create a new Contact Group, you'll enter a name for the Contact Group in the InputBox that comes up.
- To use this project, right click on Project1 and choose Insert > Userform.
- Select Listbox from the Toolbox and add it to the userform and drag to resize. Add a Command button.
- Change the form and button captions in Properties.
- Right click on the userform and choose View code.
- Paste the first macro in the code page.
- The completed userform will resemble this:
- Right click on Project1 and choose Insert > Module.
- Paste the second macro in the new module.
- Select a message and run the macro to test it
Private Sub UserForm_Initialize() Debug.Print "UF", myGroups With ListBox1 .Clear .List = Split(myGroups, ",") End With lbl_Exit: Exit Sub End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) For lngCount = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(lngCount) = True Then strDLName = ListBox1.List(DLCount) End If Next Unload Me lbl_Exit: Exit Sub End Sub Private Sub CommandButton1_Click() For lngCount = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(lngCount) = True Then strDLName = ListBox1.List(lngCount) End If Next Unload Me lbl_Exit: Exit Sub End Sub
Paste this macro in a new module.
Public strDLName As String Public myGroups As String Public Sub AddToDLGroup() Dim oDLGroup As Outlook.DistListItem Dim oRecipients As Outlook.Recipients Dim oMail As MailItem Dim newMail As MailItem Dim contactItems As Object Dim ContactsFolder As Outlook.Folder Dim Result As Integer Dim iCount As Integer myGroups = "" DLCount = 0 On Error Resume Next Set oMail = Application.ActiveExplorer.Selection.Item(1) If TypeName(oMail) <> "MailItem" Then MsgBox "You need to select an email message." Exit Sub End If Set ContactsFolder = Application.Session.GetDefaultFolder(olFolderContacts) Result = MsgBox("Add to an existing Contact Group or create a new Contact Group?" & _ vbCrLf & "Click Yes to select an existing Contact Group" & _ vbCrLf & "No to create a New group ", _ vbQuestion + vbYesNoCancel, "Contact Group already exists") If Result = vbYes Then Set contactItems = ContactsFolder.Items iCount = contactItems.Count If iCount = 0 Then MsgBox "No Contact Groups exist yet" Exit Sub End If For x = 1 To iCount If TypeName(contactItems.Item(x)) = "DistListItem" Then myGroups = contactItems.Item(x) & "," & myGroups Debug.Print myGroups End If Next x UserForm1.Show Set objContactItems = ContactsFolder.Items.Restrict("[FullName] = '" & strDLName & "'") If objContactItems.Count > 0 Then For Each objItem In objContactItems If objItem.Class = Outlook.olDistributionList Then Set oDLGroup = objItem Exit For End If Next End If ElseIf Result = vbNo Then strDLName = InputBox("Specify a name for your New Contact Group:", "Contact Group Name") Set oDLGroup = Application.CreateItem(olDistributionListItem) oDLGroup.DLName = strDLName Else Exit Sub End If Set newMail = oMail.Reply Set oRecipients = newMail.Recipients With oDLGroup .AddMembers oRecipients ' just save and close '.Close olSave ' if you want to see that the address was added to the DL .Save .Display End With newMail.Close olDiscard Set oMail = Nothing Set oRecipients = Nothing Set oDLGroup = Nothing End Sub
If you don't want to create the form yourself (it's really, really easy), I have a form and module ready for import. Download and unzip AddtoGroup code then right click on Project1 and choose Import. Select UserForm1.frm then repeat with the with AddtoGroup.bas.
How to create distribution lists from contacts of a certain category?
For example, in the Contacts folder there is a group of 100 contacts belonging to the category "Green".
After running the macro in the address book there are 5 distribution lists from 20 contacts in each of them.
The names of distribution lists can look like this: "Green-1", "Green-2", etc.
"Create a Contact Group from selected Contacts" https://www.howto-outlook.com/howto/addcontactstodl.htm - is no automation in it. Selecting elements manually, manually specifying the name, there is no category selection. I'm interested in the automatic processing of an array of elements in a category - enumeration of elements, creating and filling groups, naming them by mask.
You need to get a list of categories - https://www.slipstick.com/developer/get-color-categories-and-restore-them-using-vba/ - then filter by each category, create the list and move on to the next category. if you need to split each category into multiple lists, you'll need to add a counter and create a new group every 20.
Unless you need to do this often, it would be easier to group by category, select some contacts and create the groups. Especially if you are not skilled with vba - as it could take you hours to write (and test) a macro to do it.