Outlook VBA Run Rules Example

Use this to run Outlook Rules, can be used on a schedule or using Events, I use the Outlook App ItemSent and Quit events, as follows:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Debug.Print "Application_ItemSend"
    DeferSendWithRealSentTime.RunRules
End Sub


Calls...
'*****************************************
' Run Rules via code
' Run Rules starting with Sent using Sent Folder as param
'*****************************************
Public Sub RunRules()
 
On Error GoTo ErrHandler
   
    Dim objRules As Outlook.Rules
    Dim objRule As Outlook.Rule
   
   
    Set objRules = Application.Session.DefaultStore.GetRules
   
   
    For Each objRule In objRules
       
       Debug.Print "objRule.Name-> " & objRule.Name & ", START!"
       'Refer to the subject of the specific task item
     
       If InStr(objRule.Name, "Sent") = 1 Then
            'The corresponding specific rule
           
            With objRule
                 .Enabled = True
                 .Execute ShowProgress:=False, Folder:=Session.GetDefaultFolder(olFolderSentMail), IncludeSubfolders:=False
            End With
             
            Debug.Print "objRule.Name-> " & objRule.Name & ", DONE!"
         
        End If
    Next objRule

   
   GoTo ExitSub
 
   
ExitSub:
    'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
    'don't forget to do this -- you don't want to fall into error handling when there's no error
    Exit Sub

ErrHandler:
    'can Select Case on Err.Number if there are any you want to handle specially

    'display to user
    DebugP "RunRules ERROR: " & Err.Description

    Resume ExitSub

End Sub