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: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
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