Outlook VBA标记已删除项为已读时遇邮件撤回请求报错

问题背景 #

我在Microsoft Outlook中编写VBA代码，自动将已删除邮件文件夹中新增的所有邮件标记为已读，代码位于ThisOutlookSession模块：

原实现代码 #

模块声明区：

Private WithEvents DeletedFolder As Outlook.Items

事件处理过程：

Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)   
    If TypeOf Item Is Outlook.MailItem Then               
        Item.UnRead = False
    End If
End Sub

同时配置了Outlook规则，将特定发件人（如ABC@work.com）的邮件自动移至已删除邮件文件夹，此前代码与规则均正常运行。

问题现象 #

当发件人对已存于已删除邮件文件夹且已标记为已读的邮件发起撤回请求时，撤回消息进入已删除邮件文件夹，代码尝试标记其为已读时触发错误：

运行时错误'430'：类不支持自动化或不支持预期接口

错误发生在Item.UnRead = False语句处。

补充信息 #

• 复现步骤：添加上述代码，创建规则将特定发件人（如自身邮箱）的邮件移至已删除文件夹；给自己发送邮件，在「已发送邮件」中打开该邮件，通过「操作」发起撤回请求。
• 手动标记撤回请求消息为已读无任何报错。
• 环境：Office 2016，Outlook连接Exchange Server。

排查结果 #

通过日志代码确认，撤回请求消息的类型为MailItem，但MessageClass为IPM.Outlook.Recall：

Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler

    If TypeOf Item Is Outlook.MailItem And Item.MessageClass = "IPM.Note" Then
        Dim mail As Outlook.MailItem
        Set mail = Item
        mail.UnRead = False
    Else
        Debug.Print "Item Type: " & TypeName(Item) & " - MessageClass: " & Item.MessageClass
    End If

    Exit Sub

ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

已尝试的无效方案 #

我试过以下几种写法，均未解决问题：

' 方案1：仅判断MailItem类型
Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    If TypeName(Item) = "MailItem" Then
        Dim mail As Outlook.MailItem
        Set mail = Item
        mail.UnRead = False
    End If
End Sub

' 方案2：添加基础错误处理
Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    If TypeName(Item) = "MailItem" Then
        Dim mail As Outlook.MailItem
        Set mail = Item
        mail.UnRead = False
    Else
        Debug.Print "Item type: " & TypeName(Item)
    End If
    Exit Sub
ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

' 方案3：使用后期绑定
Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    If TypeName(Item) = "MailItem" Then
        Dim mail As Object
        Set mail = Item
        mail.UnRead = False
    End If
    Exit Sub
ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

' 方案4：通过Class属性判断
Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    If Item.Class = olMail Then
        Item.UnRead = False
    Else
        Debug.Print "Item Class: " & Item.Class
    End If
    Exit Sub
ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

有效解决方案 #

方案1：过滤撤回请求类型的邮件 #

由于撤回请求可手动标记已读，且这类消息通常无需自动处理，直接通过MessageClass过滤即可：

Private WithEvents DeletedFolder As Outlook.Items

' 必须添加初始化代码，否则事件不会触发
Private Sub Application_Startup()
    Set DeletedFolder = Application.Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub

Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    
    Dim mail As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        Set mail = Item
        ' 仅处理普通邮件（排除撤回请求等特殊类型）
        If mail.MessageClass = "IPM.Note" Then
            mail.UnRead = False
            mail.Save ' 确保修改生效
        End If
    End If
    
    Exit Sub
ErrorHandler:
    Debug.Print "处理失败: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

方案2：通过MAPI属性设置已读（兼容特殊MailItem） #

如果需要对撤回请求也自动标记已读，可直接修改底层MAPI属性绕过接口限制：

Private WithEvents DeletedFolder As Outlook.Items

Private Sub Application_Startup()
    Set DeletedFolder = Application.Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub

Private Sub DeletedFolder_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    
    Dim mail As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        Set mail = Item
        ' 修改MAPI属性PR_MESSAGE_FLAGS标记为已读
        mail.PropertyAccessor.SetProperty _
            "http://schemas.microsoft.com/mapi/proptag/0x0E070003", _
            mail.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E070003") Or &H1000
        mail.Save
    End If
    
    Exit Sub
ErrorHandler:
    Debug.Print "处理失败: " & Err.Number & " - " & Err.Description
    Resume Next
End Sub

关键提示 #

• 务必添加Application_Startup过程：原代码可能遗漏了初始化DeletedFolder的步骤，只有在Outlook启动时绑定已删除邮件文件夹的Items对象，事件才能正常触发。
• IPM.Outlook.Recall属于Exchange特殊MailItem，部分标准属性的访问受系统限制，过滤或直接操作MAPI属性是更可靠的处理方式。

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