Macro to execute certain rules in Outlook

Sub Run_RuleSet()
Dim olkRuleSet() As Variant
Dim olkRule As Variant
Dim olRules As Outlook.Rules
Dim olRule As Outlook.Rule
Dim intcount As Integer
Dim strStatus As String
 
    olkRuleSet = Array("Rule1", "Rule2")
    Set olRules = Application.Session.DefaultStore.GetRules
 
    strStatus = "All Outlook rules enabled and Run:" & vbCrLf
    For Each olkRule In olkRuleSet
        Set olRule = olRules(olkRule)
        olRule.Enabled = True
        olRule.Execute ShowProgress:=True
        intcount = intcount + 1
        strStatus = strStatus & vbCrLf & intcount & ". " & olRule.Name
    Next
    olRules.Save
    MsgBox strStatus, vbInformation, "Outlook Rule Automation."
 
    Set olRules = Nothing
    Set olRule = Nothing
End Sub

Select allOpen in new window