View Single Post
 
Old 09-03-2021, 08:41 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,621
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

Create a userform with a single list box large enough to list your rules and name it 'frmRunRules'.
Add two command buttons below the list box.
Add the following code to the userform:
Code:
Option Explicit
Private olStore As Outlook.Store
Private olRules As Outlook.Rules
Private rl As Outlook.Rule
Private Count As Integer
Private olRuleList As String
Private i As Long
Private j As Long
Private temp As Variant

Private Sub CommandButton2_Click()
    Unload Me
lbl_Exit:
    Exit Sub
End Sub

Private Sub UserForm_Initialize()
    Set olStore = Session.DefaultStore
    Set olRules = olStore.GetRules
    BackColor = &HC0E1BF
    Caption = "Select the Rules to Run on the Inbox"
    CommandButton1.Caption = "Run the Selected Rules"
    CommandButton2.Caption = "Cancel"
    
    With ListBox1
        .Clear
        On Error Resume Next
        For Each rl In olRules
            .AddItem rl.Name
        Next rl
        For j = 0 To .ListCount - 2
            For i = 0 To .ListCount - 2
                If UCase(.List(i)) > UCase(.List(i + 1)) Then
                    temp = .List(i)
                    .List(i) = .List(i + 1)
                    .List(i + 1) = temp
                End If
            Next i
        Next j
        .MultiSelect = fmMultiSelectExtended
    End With
    RemoveCloseButton Me
lbl_Exit:
    Exit Sub
End Sub

Private Sub CommandButton1_Click()
    Hide
    Set olStore = Session.DefaultStore
    Set olRules = olStore.GetRules
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Set rl = olRules.Item(.List(i))
                If rl.RuleType = olRuleReceive Then
                    ' if so, run it
                    rl.Execute showprogress:=True
                    Count = Count + 1
                    olRuleList = olRuleList & vbCrLf & rl.Name
                End If
            End If
        Next i
    End With
    olRuleList = "These rules were executed against the Inbox: " & vbCrLf & olRuleList
    MsgBox olRuleList, vbInformation, "Outlook Rules"

    Set rl = Nothing
    Set olStore = Nothing
    Set olRules = Nothing
    Unload Me
lbl_Exit:
    Exit Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
lbl_Exit:
    Exit Sub
End Sub
Call the userform from your button with the code -

Code:
Sub RunMyRules()
    frmRunRules.Show
lbl_Exit:
    Exit Sub
End Sub
When run, select the rules you wish to run on the Inbox from the list box.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote