Outlook宏自动移除重复收件人触发运行时错误'91'求助

错误原因 #

在myAttOriginatorMail_ReplyAll事件触发时，回复邮件窗口尚未完全激活，此时ActiveInspector.CurrentItem无法获取到有效的邮件对象，导致抛出"对象变量或With块变量未设置"的错误。手动运行时窗口已打开，所以能正常获取对象。

修复方案 #

直接将ReplyAll事件中生成的Response对象传递给去重子程序，而非依赖ActiveInspector获取当前邮件。

步骤1：修改独立模块的去重代码

将Remove_Duplicate_Recipients改为接受MailItem参数的子程序，移除依赖ActiveInspector的行：

Option Explicit
Option Compare Text

Sub Remove_Duplicate_Recipients(objCurrentMail As MailItem)
    Dim objRecipients As Recipients
    Dim ContactGroupFound As Boolean
    Dim i As Long, n As Long
 
    ' 移除原有的Set objCurrentMail = ActiveInspector.CurrentItem行
    ContactGroupFound = True
 
    While ContactGroupFound = True
          Set objRecipients = objCurrentMail.Recipients
          ContactGroupFound = False
 
    'Expand the contact groups in "To" field
          For i = objRecipients.Count To 1 Step -1
              If objRecipients(i).AddressEntry.DisplayType <> olUser Then
                 For n = 1 To objRecipients(i).AddressEntry.Members.Count
                     If objRecipients(i).AddressEntry.Members.Item(n).DisplayType = olUser Then
                        objCurrentMail.Recipients.Add (objRecipients(i).AddressEntry.Members.Item(n).Address)
                     Else
                        objCurrentMail.Recipients.Add (objRecipients(i).AddressEntry.Members.Item(n).Name)
                        ContactGroupFound = True
                     End If
                 Next
                 objRecipients(i).Delete
              End If
          Next i
          objRecipients.ResolveAll
    Wend
 
'Remove the duplicate recipients
    For i = objRecipients.Count To 1 Step -1
        For n = (i - 1) To 1 Step -1
            If objRecipients(i).Address = objRecipients(n).Address Then
               objRecipients(i).Delete
               Exit For
            End If
        Next
    Next
End Sub

步骤2：修改ThisOutlookSession中的调用代码

在ReplyAll事件中直接传入Response对象，并添加类型判断确保安全：

Option Explicit
Option Compare Text
Private WithEvents myAttExp As Explorer
Private WithEvents myAttOriginatorMail As MailItem
Dim WithEvents oMailItem As Outlook.MailItem

Private Sub Application_Startup()
    Set myAttExp = ActiveExplorer
End Sub

Private Sub myAttOriginatorMail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
  If Response.Body Like "*Test*" Then
      Response.Recipients.Add ("TestGroup")  'name of Contact_Group
       Response.Recipients.ResolveAll
       ' 传入Response对象，先判断类型
       If TypeOf Response Is MailItem Then
           Remove_Duplicate_Recipients Response
       End If
  End If
End Sub

Private Sub myAttExp_SelectionChange()
  On Error Resume Next
    If TypeOf myAttExp.Selection.Item(1) Is MailItem Then
        Set myAttOriginatorMail = myAttExp.Selection.Item(1)
    End If
End Sub

额外说明 #

• 这样修改后，去重逻辑直接操作事件中生成的回复邮件对象，无需依赖窗口激活状态，避免了对象未初始化的错误。
• 类型判断TypeOf Response Is MailItem能防止非邮件类型的响应触发错误，提升代码健壮性。

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