StartDownloadsServiceSamplesWorkshopsContact DeutschEnglish
 
Samples
General
Outlook®
 
Awarded by
Microsoft since 2005:
mvp logo
VBOffice Info
Visitors1748332
Impressions6558722
Links
Imprint
Privacy Policy
Contact
E-Mail: Trigger actions with categories
Author: Michael BauerHomepage
Date: 17.10.2008Accessed: 22474
  
Description

Categories qualify very well for triggering certain actions.

#1: The first example moves an email to a certain subfolder of the inbox as soon as you assign a certain category. If more categories are assigned, they'll be ignored. Just customize the two variables in the 'Mail_PropertyChange' procedure (the category to look for, and the name of the subfolder).

#2: The second example moves the email to a subfolder of the inbox that matches the name of the category.

#3: The third example runs all the rules you have set up for the store of the folder you currently look at. (This example requires Outlook 2007 or higher.)

Copy the code to the modul 'ThisOutlookSession'. The procedure 'Mail_PropertyChange' must be copied only once, either sample #1, #2, or #3.

Private WithEvents Explorer As Outlook.Explorer
Private WithEvents Mail As Outlook.MailItem

Friend Sub Application_Startup()
  On Error Resume Next
  Set Explorer = Application.ActiveExplorer
End Sub

Private Sub Explorer_SelectionChange()
  Dim obj As Object
  Dim Sel As Outlook.Selection

  Set Mail = Nothing
  Set Sel = Explorer.Selection

  If Sel.Count > 0 Then
    Set obj = Sel(1)
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
    End If
  End If
End Sub

'Sample #1
Private Sub Mail_PropertyChange(ByVal Name As String)
  Dim Ns As Outlook.NameSpace
  Dim SubfolderName As String
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder
  Dim i&
  Dim Cats As String
  Dim arrCats() As String
  Dim FindCategory As String

  ' Customize
  FindCategory = " (Actionlist)"
  SubfolderName = "test"

  Set Ns = Application.GetNamespace("MAPI")
  Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
  Set Subfolder = Inbox.Folders(SubfolderName)
  If Subfolder.EntryID = Mail.Parent.EntryID Then
    Exit Sub
  End If

  If Name = "Categories" Then
    Cats = LCase$(Mail.Categories)
    FindCategory = LCase$(FindCategory)
    If Len(Cats) = 0 Then Exit Sub
    Cats = Replace(Cats, ",", ";")
    arrCats = Split(Cats, ";")
    For i = 0 To UBound(arrCats)
      Cats = Trim$(arrCats(i))
      If Cats = FindCategory Then
        Mail.Move Subfolder
        Set Mail = Nothing
        Exit For
      End If
    Next
  End If
End Sub

'Sample #2
Private Sub Mail_PropertyChange(ByVal Name As String)
  Dim Ns As Outlook.NameSpace
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder
  Dim SubfolderName As String

  If Name = "Categories" Then
    Set Ns = Application.GetNamespace("MAPI")
    Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
    SubfolderName = Mail.Categories
    If Len(SubfolderName) = 0 Then Exit Sub
    Set Subfolder = Inbox.Folders(SubfolderName)
    If Subfolder.EntryID <> Mail.Parent.EntryID Then
      Mail.Move Subfolder
      Set Mail = Nothing
    End If
  End If
End Sub

'Sample #3
Private Sub Mail_PropertyChange(ByVal Name As String)
  Dim CurrentFolder As Outlook.Folder
  Dim CurrentStore As Outlook.Store
  Dim Rules As Outlook.Rules
  Dim Rule As Outlook.Rule
  Dim i&
  Dim Cats As String
  Dim arrCats() As String
  Dim FindCategory As String
  Dim RunRules As Boolean

  ' Customize:
  FindCategory = "(Actionlist)"

  If Name = "Categories" Then
    Cats = LCase$(Mail.Categories)
    FindCategory = LCase$(FindCategory)
    If Len(Cats) = 0 Then Exit Sub
    Cats = Replace(Cats, ",", ";")
    arrCats = Split(Cats, ";")
    For i = 0 To UBound(arrCats)
      Cats = Trim$(arrCats(i))
      If Cats = FindCategory Then
        Set Mail = Nothing
        RunRules = True
        Exit For
      End If
    Next
  End If

  If RunRules Then
    Set CurrentFolder = Application.ActiveExplorer.CurrentFolder
    Set CurrentStore = CurrentFolder.Store
    Set Rules = CurrentStore.GetRules
    For Each Rule In Rules
      If Rule.Enabled Then
        Rule.Execute
      End If
    Next
  End If
End Sub
 
 

ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the ... [more]

 

Access the master category list in the blink of an eye, share your categories in a network, get a reminder service, and ... [more]

 

SAM automatically sets the sender, signature, and folder for sent items, for instance based on the recipient ... [more]

 

OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or ... [more]