Outlook VBA脚本编译错误：参数不可选问题及解决

问题描述 #

运行VBA脚本时出现编译错误：

Compile error:
Argument not optional.
错误指向代码行：

Set blockedSendersRule = blockedSenders.Create("Blocked Domains")

错误原因 #

Outlook的Rules.Create方法要求传入两个必填参数：

1. 规则名称（字符串类型）
2. 规则类型（OlRuleType枚举值）
   你仅提供了规则名称，缺少规则类型参数，导致编译报错。针对阻止接收邮件发件人域名的场景，需使用olRuleReceive类型。

修正方案 #

在Create方法中补充olRuleReceive参数，修正后的代码行：

Set blockedSendersRule = blockedSenders.Create("Blocked Domains", olRuleReceive)

完整修正后代码 #

Sub AddDomainsToBlockedSendersList()
    Dim olSelection As Selection
    Dim olItem As Object
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim blockedSenders As Outlook.Rules
    Dim blockedSendersRule As Outlook.Rule
    Dim domainList As Collection
    Dim domain As String
    Dim msg As String
    
    ' Initialize Outlook objects
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set blockedSenders = olNamespace.DefaultStore.GetRules()
    Set domainList = New Collection
    
    ' Get selected emails
    Set olSelection = olApp.ActiveExplorer.Selection
    
    ' Loop through selected emails
    For Each olItem In olSelection
        If olItem.Class = olMail Then
            domain = GetDomainFromEmail(olItem.SenderEmailAddress)
            If Not IsDuplicate(domain, domainList) Then
                domainList.Add domain
            End If
        End If
    Next olItem
    
    ' Add domains to blocked senders list
    If domainList.Count > 0 Then
        ' 添加olRuleReceive参数修正编译错误
        Set blockedSendersRule = blockedSenders.Create("Blocked Domains", olRuleReceive)
        
        For Each domain In domainList
            blockedSendersRule.Conditions.From.Recipients.Add domain
        Next domain
        
        blockedSendersRule.Enabled = True
        blockedSenders.Save
        msg = "Domains added to the Blocked Senders list."
    Else
        msg = "No valid domains found in selected emails."
    End If
    
    ' Display a message box
    MsgBox msg, vbInformation, "Add Domains to Blocked Senders List"
End Sub

Function GetDomainFromEmail(email As String) As String
    Dim parts() As String
    parts = Split(email, "@")
    If UBound(parts) = 1 Then
        GetDomainFromEmail = parts(1)
    Else
        GetDomainFromEmail = ""
    End If
End Function

Function IsDuplicate(domain As String, domainList As Collection) As Boolean
    On Error Resume Next
    domainList.Add domain, CStr(domain)
    IsDuplicate = (Err.Number = 457) ' 457 = "Key is already associated with an element of this collection"
    Err.Clear
    On Error GoTo 0
End Function

内容的提问来源于stack exchange，提问作者cAYK