Add a Category to Contacts in a Contact Group (DL)

Last reviewed on December 4, 2012

We have another code sample from Valk Beekman. This code sample parses a distribution list, looking for the contact with the mail address and adds a category to it.

You can use this to more easily see what contact groups the contact belongs to or to convert contact groups to dynamic distribution lists.

The contacts do not have a category assignedAfter you run the macro, the contacts are in the desired category

To use, select the Contact group (distribution list) and run the macro. The category you've set as t_cat variable will be added to the contacts. Note that the category must exist in the master category list for this to work.

Add Category to Contact Group Members Macro

To use, open the VBA Editor using Alt+F11 and paste the code into a new module.

Get the GetCurrentItem function from Outlook VBA: work with open item or selected item and paste it at the end of the module.

Open or select the Contact Group and run the macro.


Sub distrib_to_cat()
Dim N_NS As NameSpace
Dim o_fold As Items
Dim o_list As Object
Dim o_dfold As Items
Dim o_cont  As Object
Dim b_Found As Boolean

' fill in you category here.
    t_cat = "dist-1"

Set N_NS = Application.GetNamespace("MAPI") 

'current contact folder
Set o_fold = Application.ActiveExplorer.CurrentFolder.Items.Restrict("[Email1Address]>''")  

' select or open the distributionlist 
Set o_list = GetCurrentItem()

'main contact folder 
Set o_dfold = N_NS.GetDefaultFolder(olFolderContacts).Items.Restrict("[Email1Address]>''") 

For i = 1 To o_list.MemberCount
     t_test = "[Email1Address] = '" & o_list.GetMember(i).Address & "'"
     Set o_cont = o_fold.Find(t_test)
     b_Found = Not (o_cont Is Nothing)
     If Not b_Found Then 'look in main contacts
        Set o_cont = o_dfold.Find(t_test)
        b_Found = Not (o_cont Is Nothing)
     End If
     If b_Found Then
        If InStr(o_cont.Categories, t_cat) = 0 Then
            o_cont.Categories = o_cont.Categories + ";" + t_cat
            o_cont.Save
        End If
     End If
     b_Found = False
Next
End Sub

Written by

If you would like to submit guest articles to Slipstick.com, please contact us through our Feedback form.