How to Quickly Create a Contact Group from All Outlook Contacts with a Specific Job Title

So as to communicate with the contacts with a specific job title more easily, you may want to quickly create a contact group from these contacts. Now, in this article, we will share a fast method with you.

If you frequently batch send emails, tasks or meeting invitations to the contacts having a specific job title, it will be much more convenient if you create a contact group from them. Generally, in the standard way, you need to first create a new contact group and then add contacts to the group as members one by one. It is a bit troublesome. Therefore, in the followings, we’ll teach you a much faster way to get it.

Create a Contact Group from All Contacts with a Specific Job Title

1. At first, in a Contacts folder, select a contact which has the specific job title.
2. Then, press “Alt + F11” to access Outlook VBA editor.
3. Next, copy the following VBA code into a blank module or project.

Dim objContact As Outlook.ContactItem
Dim strJobTitle As String
Dim objNewGroup As Outlook.DistListItem
Dim objTempMail As Outlook.MailItem

Sub CreateContactGroupfromContactsSameJobTitle()
    Dim objStore As Outlook.Store
    Dim objOutlookFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
    Set objContact = Outlook.Application.ActiveExplorer.Selection(1)
    strJobTitle = objContact.JobTitle
 
    Set objNewGroup = Outlook.Application.CreateItem(olDistributionListItem)
    Set objTempMail = Outlook.Application.CreateItem(olMailItem)
 
    'Process all Contacts folders
    For Each objStore In Outlook.Application.Session.Stores
        Set objOutlookFile = objStore.GetRootFolder
        For Each objFolder In objOutlookFile.Folders
            If objFolder.DefaultItemType = olContactItem Then
               Call ProcessContactsFolders(objFolder)
            End If
        Next
    Next
 
    objNewGroup.AddMembers objTempMail.Recipients
    objNewGroup.Display
End Sub

Sub ProcessContactsFolders(ByVal objCurFolder As Outlook.Folder)
    Dim objItem As Object
    Dim objSubfolder As Outlook.Folder
 
    For Each objItem In objCurFolder.Items
        If objItem.Class = olContact Then
           If objItem.JobTitle = strJobTitle Then
              'Add the contact having the specific job title to the new group
              objTempMail.Recipients.Add (objItem.Email1Address)
              objTempMail.Recipients.ResolveAll
           End If
        End If
    Next
 
    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubfolder In objCurFolder.Folders
           Call ProcessContactsFolders(objSubfolder)
       Next
    End If
End Sub

4. After that, move cursor into the first subroutine.
5. Finally, tap on “F5” key button to run this macro.
6. When macro completes, a new contact group will display. It contains all the contacts with the same job title of the selected contact in Step 1.

Shield Outlook Data Effectively

Although Outlook is feature-rich, it cannot get rid of the fact that it is vulnerable. So, if you don’t want to lose your precious Outlook data, you have to make efforts to protect it. For instance, you need to make backups for Outlook data at regular intervals. Also, if affordable, it is recommended to have a cutting-edge PST repair tool, such as DataNumen Outlook Repair, which can repair PST data in a jiff.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupted sql and outlook repair software products. For more information visit www.datanumen.com