vba - 运行规则的宏

Question

我从网上获得了以下代码来运行 Outlook 2010 规则。

我试图通过从组合框中选择一次只运行一个规则，但它运行所有规则。

我也希望它在完成后显示规则的名称。

Option Explicit
Private st As Outlook.Store
Private myRules As Outlook.Rules
Private rl As Outlook.Rule
Private count As Integer
Private ruleList As String
Private i As Long

Private Sub cmd_close_Click()
    Me.cmb_select_rule.Clear
    Unload Me
End Sub

Sub RunMyRules()
    frmRunRules.Show
End Sub

Private Sub frmRunRules_Initialize()
    Set st = Application.Session.DefaultStore
    Set myRules = st.GetRules
    With Me.cmb_select_rule
        .Clear
        For Each rl In myRules
            .AddItem rl.Name
        Next rl
    End With
End Sub

Private Sub cmdRun_Click()
    Me.Hide
    Set st = Application.Session.DefaultStore
    Set myRules = st.GetRules
    With Me.cmb_select_rule
        For i = 0 To .ListCount - 1
            If .ListIndex(i) Then
                Set rl = myRules.Item(.List(i))
                If rl.RuleType = olRuleReceive Then
                    ' if so, run it
                    rl.Execute ShowProgress:=True
                    count = count + 1
                    ruleList = ruleList & vbCrLf & rl.Name
                End If
            End If
        Next i
    End With
    ruleList = "These rules were executed against the Inbox: " & vbCrLf & ruleList
    MsgBox ruleList, vbInformation, "Outlook Rules"
    Set rl = Nothing
    Set st = Nothing
    Set myRules = Nothing
    Me.cmb_select_rule.Clear
End Sub

Answer 1

Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim runrule As String
Dim rulename As String
rulename = "Your Rule Name"
Set st = Application.Session.DefaultStore
Set myRules = st.GetRules
Set cf = Application.ActiveExplorer.CurrentFolder
For Each rl In myRules
If rl.RuleType = olRuleReceive Then
If rl.Name = rulename Then
rl.Execute ShowProgress:=True, Folder:=cf
runrule = rl.Name
End If
End If
Next
ruleList = "Rule was executed correctly:" & vbCrLf & runrule
MsgBox ruleList, vbInformation, "Macro: Whatever_Finished"
Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub

尝试在上面运行单个规则，只需将规则名称编辑为您现有的规则之一，并将 Whater_Finished 编辑为您想要的任何内容...没有组合框，但您可以从这里开始。