This macro sample watches the Inbox for new messages and checks for a contact for the sender. If there is a contact and it has one or more categories assigned to it, the Contact's categories are added to the message.

This macro, as written, is an ItemAdd macro and checks all messages that are added to the Inbox but it can be converted to run in a run a script rule instead. To use it to categorize messages already in your inbox or test it without sending messages, select a message and run the ContactCategoriesManual macro.

 
Private WithEvents olInboxItems As Items
 
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
  Set objNS = Nothing
End Sub
 
 'Use this to run the macro on a message already in the Inbox
Public Sub ContactCategoriesManual()
    Dim objMail As Object
    Set objMail = Application.ActiveExplorer.Selection.Item(1)
    olInboxItems_ItemAdd objMail  
Set objMail = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
'To use in a run a script rule
'Sub ContactCategories(Item As MailItem)
     Dim oContact As Outlook.ContactItem
     Dim oSender 
     
Set oSender = Item.Sender

If Not oSender Is Nothing Then

     Set oContact = oSender.GetContact
             Set oSender = Nothing
             
             If Not oContact Is Nothing Then
                 Item.Categories = oContact.Categories
                 Set oContact = Nothing
                 Item.Save
                         
            Set Item = Nothing
             End If
         End If
 End Sub

Move Messages to Folder Based on Contact Category

This version of the macro moves messages to a folder based on the category assigned to the sender's contact. This version of the macro works with multiple categories assigned to a contact but if the sender's contact has more than one category match, the message is not moved. You'll need to move the message to the correct folder yourself.

You can use partial category names in arrCategoryName, but you need to use enough characters to be unique. Use lower case!

Private WithEvents olInboxItems As Items
Dim olInbox As Outlook.Folder
  
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
' update with correct inbox
  Set olInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set olInboxItems = olInbox.Items
  Set objNS = Nothing
End Sub
  
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
     Dim oContact As Outlook.ContactItem
     Dim oSender
     Dim strFolderName As String
     Dim strCategoryName As String
     Dim arrCategoryName As Variant
Dim arrFolder As Variant
Dim arr As Variant

j = 0
Set oSender = Item.Sender
 
If Not oSender Is Nothing Then
 
     Set oContact = oSender.GetContact
     Debug.Print oContact.FullName
             If Not oContact Is Nothing Then

  Debug.Print oContact.Categories
  strContactCats = oContact.Categories
' Set up the array, use lower case
arrCategoryName = Array("sales", "service", "accounting", "client")
' folder names subfolders of Inbox
arrFolder = Array("Sales", "Service Requests", "Accounting & Invoices", "Call Back")
 
' Go through the array and look for a match, then do something
For i = LBound(arrCategoryName) To UBound(arrCategoryName)
    If InStr(LCase(strContactCats), arrCategoryName(i)) > 0 Then
    j = j + 1
    strFolderName = arrFolder(i)
    Debug.Print j, strFolderName
    End If
Next i

' We count matches and don't move if there is more than one match
If j > 1 Then Exit Sub
If strFolderName = "" Then Exit Sub

' set the move to folder
Set MoveFolder = olInbox.Folders(strFolderName)
Item.Move MoveFolder

    Set Item = Nothing
    Set oContact = Nothing
    Set oSender = Nothing
    End If
End If
 End Sub

How to use this macro

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To use the macro code in ThisOutlookSession:

1. Expand Project1 and double click on ThisOutlookSession.
2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)

More information as well as screenshots are at How to use the VBA Editor