VBOffice

Search Address in To Field and Run a Rule

Outlook can run a rule if you are the only recipient of an email. This macro runs a rule if you are the only recipient in the To field, no matter how many other addresses there is in the CC field.

Last modified: 2015/07/24 | Accessed: 24.152  | #150
◀ Previous sample Next sample ▶
Category-Manager Category-Manager
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP.

This script runs a rule, if you are the only recipient in the To field, no matter how many other recipients there is in CC. In this sample the email will be colored by assigning a category.

Replace the address 'test_1@domain.com' by your own address. If you want to search multiple addresses, simply copy the line of code accordingly. The variable AdrType controls whether your addresses will be searched in the To field or in the CC field. Also, replace the category 'vboffice' by any one of your choice.

Create a new rule, choose the action 'Run a script', and select the script 'ToAddressRule'.


tip  How to add macros to Outlook
Public Sub ToAddressRule(Mail As Outlook.MailItem)
  Dim CheckTo As Boolean
  Dim CheckCC As Boolean
  Dim Recipients As Outlook.Recipients
  Dim R As Outlook.Recipient
  Dim Addresses As New VBA.Collection
  Dim Nok As Boolean
  Dim AdrType As Long
  Dim Category As String
  Dim Adr As String
  
  'My addresses I want to search
  Adr = "test_1@domain.com": Addresses.Add Adr, Adr
  
  'Look for my addresses in To (replace olTo by olCC for looking in CC)
  AdrType = olTo
  
  'If I'm the only one in To, assign this category
  Category = "vboffice"
  
  Set Recipients = Mail.Recipients
  For Each R In Recipients
    If R.Type = AdrType Then
      If ItemExists(Addresses, R.Address) = False Then
        Nok = True
        Exit For
      End If
    End If
  Next
  
  If Nok Then
    Mail.Categories = Category
    Mail.Save
  End If
End Sub

Private Function ItemExists(Addresses As VBA.Collection, Adr As String) As Boolean
  On Error Resume Next
  Debug.Print Addresses(Adr)
  ItemExists = (Err.Number = 0)
End Function
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.
email  Send a message