StartDownloadsServiceSamplesWorkshopsContact DeutschEnglish
 
Samples
General
Outlook®
 
Awarded by
Microsoft since 2005:
mvp logo
VBOffice Info
Visitors1829315
Impressions6867864
Links
Imprint
Privacy Policy
Contact
E-Mail: Trigger actions with categories
Author: Michael BauerHomepage
Date: 17.10.2008Accessed: 23596
  
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.

For the examples #1 and #2 you also need to add a standard modul to your project. To that module copy the code that you find between the comments 'Begin: modTimer' and 'End: modTimer'. Also, if you're running an English version, you need to rename DieseOutlookSitzung to ThisOutlookSession, see the comment in the modTimer modul.

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

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
        Set MoveToThisFolder = Subfolder
	EnableTimer 500, Me
        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
      Set MoveToThisFolder = Subfolder
      EnableTimer 500, Me
    End If
  End If
End Sub

'Sample #1 / Sample #2
Friend Sub Timer()
  DisableTimer
  Mail.Move MoveToThisFolder
  Set Mail = Nothing
  Set MoveToThisFolder = Nothing
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

'Begin: modTimer
Option Explicit
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, _
  ByVal nIDEvent As Long, ByVal uElapse As Long, _
  ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, _
  ByVal nIDEvent As Long) As Long

Const WM_TIMER = &H113

Private hEvent As Long

'Rename 'DieseOutlookSitzung' to ThisOutlookSession if you're running an English version
Private m_Callback As DieseOutlookSitzung

Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long _
)
  If uMsg = WM_TIMER Then
    If Not m_Callback Is Nothing Then
      m_Callback.Timer
    End If
  End If
End Sub

Public Function EnableTimer(ByVal msInterval As Long, Callback As Object) As Boolean
  If hEvent <> 0 Then
    Exit Function
  End If
  If Not Callback Is Nothing Then
    hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)
    Set m_Callback = Callback
  End If
  EnableTimer = CBool(hEvent)
End Function

Public Function DisableTimer()
  If hEvent = 0 Then
    Exit Function
  End If
  KillTimer 0&, hEvent
  hEvent = 0
  Set m_Callback = Nothing
End Function
'End: modTimer
 
 

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]