请求验证自动拒绝通讯组列表会议邀请的VBA脚本有效性

你的这段Outlook VBA脚本存在几个关键问题，无法直接正常工作，以下是具体问题和修正后的版本：

原脚本的错误点 #

• Split函数参数错误：Split(EntryIDCollection, "\","\") 语法错误，Split函数仅需两个参数（待分割字符串+分隔符），多余的第三个参数会导致运行报错。
• 收件人集合直接比较无效：xMeeting.Recipients是收件人集合对象，不能直接与字符串"support.bridge@company.com"做相等比较，必须遍历收件人列表逐一检查。
• 错误处理过于宽泛：On Error Resume Next会屏蔽所有错误，导致脚本出问题时无法排查原因，应该针对性处理错误。

修正后的脚本 #

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim xEntryIDs As Variant
    Dim xItem As Object
    Dim i As Integer
    Dim xMeeting As MeetingItem
    Dim xAppointmentItem As AppointmentItem
    Dim xMeetingDeclined As MeetingItem
    Dim xRecipient As Recipient
    Dim isTargetGroup As Boolean
    
    ' 分割EntryID集合
    xEntryIDs = Split(EntryIDCollection, "\")
    
    For i = 0 To UBound(xEntryIDs)
        On Error Resume Next
        Set xItem = Application.Session.GetItemFromID(xEntryIDs(i))
        On Error GoTo 0 ' 关闭全局错误捕获
        
        If Not xItem Is Nothing Then
            ' 判断是否为会议邀请
            If xItem.Class = olMeetingRequest Then
                Set xMeeting = xItem
                xMeeting.ReminderSet = False
                isTargetGroup = False
                
                ' 遍历所有收件人，检查是否包含目标通讯组
                For Each xRecipient In xMeeting.Recipients
                    If VBA.LCase(xRecipient.Address) = VBA.LCase("support.bridge@company.com") Then
                        isTargetGroup = True
                        Exit For ' 找到目标后退出循环
                    End If
                Next xRecipient
                
                ' 如果是发送到目标通讯组的邀请，自动拒绝
                If isTargetGroup Then
                    Set xAppointmentItem = xMeeting.GetAssociatedAppointment(True)
                    xAppointmentItem.ReminderSet = False
                    Set xMeetingDeclined = xAppointmentItem.Respond(olMeetingDeclined)
                    xMeetingDeclined.Body = "此会议邀请发送至我已不再所属的通讯组，故自动拒绝。"
                    xMeetingDeclined.Send
                    xMeeting.Delete
                End If
            End If
            Set xItem = Nothing
        End If
    Next i
End Sub

修正说明 #

1. 修复了Split函数的参数错误，正确分割EntryID集合。
2. 添加收件人遍历逻辑，逐一检查每个收件人的地址是否匹配目标通讯组邮箱。
3. 优化错误处理，仅在获取邮件Item时临时启用错误捕获，避免屏蔽所有错误。
4. 自定义拒绝邮件的正文，清晰说明拒绝原因。
5. 添加对象释放步骤，避免内存泄漏。

使用注意事项 #

• 打开Outlook，按Alt+F11打开VBA编辑器。
• 在左侧项目窗格中找到ThisOutlookSession，双击打开后粘贴修正后的脚本。
• 保存并重启Outlook，脚本即可生效。
• 建议先测试：让同事发送一封到目标通讯组的测试会议邀请，验证是否自动拒绝。

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