How to Quickly Find All the Contact Groups Containing a Specific Contact with Outlook VBA

At times, you may want to find all the contact groups containing a specific contact. This article will teach you how to quickly get it without needs to check groups one by one.

When you desire to find out the contact groups which contain a specific contact, in general, you have to check all the existing groups one by one in your Outlook. There is no doubt that it will be a very tedious task. In order to simplify this, here we will expose a piece of VBA code to you, which enable you to achieve it just via few clicks.

Find All the Contact Groups Containing a Specific Contact

1. At the very beginning, start your Outlook program as normal.
2. Then in the subsequent Outlook main interface, press “Alt + F11” keys.
3. Next you’ll enter “Microsoft Visual Basic for Applications” window, in which you need to open the “ThisOutlookSession” project.
4. Subsequently, you should copy the following VBA code into this project.

Sub Application_ItemContextMenuDisplay(ByVal CommandBar As Office.CommandBar, ByVal Selection As Selection)
    Dim objCommandBarButton As Office.CommandBarButton
 
    'Add "Related Contact Groups" to the ContactItem's Context Menu
    If (Selection.count = 1) And (Selection.Item(1).Class = olContact) Then
       Set objCommandBarButton = CommandBar.Controls.Add(msoControlButton)
 
       With objCommandBarButton
            .Style = msoButtonIconAndCaption
            .Caption = "Related Contact Groups"
            .FaceId = 2131
            .OnAction = "Project1.ThisOutlookSession.FindRelatedContactGroups"
      End With
    End If
End Sub

Sub FindRelatedContactGroups()
    Dim objContact As Outlook.ContactItem
    Dim objContacts As Outlook.Items
    Dim objContactGroup As Outlook.DistListItem
    Dim objGroupMember As Outlook.recipient
    Dim i, n, x As Long
    Dim strMsg As String
 
    'Get the selected contact
    Set objContact = Application.ActiveExplorer.Selection.Item(1)
    'Get the default contact group
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
 
    i = 0
    n = 0
    x = 0
    For i = objContacts.count To 1 Step -1
        If TypeOf objContacts.Item(i) Is DistListItem Then
           Set objContactGroup = objContacts.Item(i)

           For n = 1 To objContactGroup.MemberCount
               Set objGroupMember = objContactGroup.GetMember(n)
               'If the contact is within the contact group
               If InStr(1, objGroupMember.Name, objContact.FullName) > 0 Then
                  'Add to message
                  x = x + 1
                  strMsg = strMsg & x & ": " & objContactGroup.DLName & vbCrLf
               End If
           Next
       End If
    Next
 
    'Prompt you
    If strMsg <> "" Then
       strMsg = "Find " & x & " contact group(s) containing " & objContact.FullName & ":" & vbCrLf & vbCrLf & strMsg
       MsgBox strMsg, vbInformation + vbOKOnly, "Find Related Contact Groups"
    Else
       MsgBox "No contact group containing " & objContact.FullName & ".", vbInformation + vbOKOnly, "Find Related Contact Groups"
    End If
End Sub

5. After that, you should sign this code.
6. Later change your Outlook macro settings to permit signed VBA project.
7. Eventually you can take a try.

• Firstly, select and right click on a contact in the contact list.
• From the popup context menu, you can see and choose “Related Contact Groups” option.
• Then you will receive a message. If there is group related to this contact, the message will look like the following screenshot:
• But if there is no related group, you’ll get a message shown as the image below:

Block Outlook Corruption with Ease

Due to the fact that Outlook is error prone and corruption, it’ll take a lot of time and energy to prevent Outlook data corruption. For example, you should persist in making regular Outlook data backups. In addition, you have to learn some tips to cope with various random PST issues. Last but not least, you ought to prepare a powerful Outlook repair utility, like DataNumen Outlook Repair. It is capable of solving Outlook troubles like a cork.

Author Introduction:

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