为外部收件人设置Outlook邮件到期时间的VBA问题

一、外部收件人邮件到期时间失效的原因及解决 #

Outlook的ExpiryTime属性本质是MAPI专属属性，仅在同一Exchange/Office 365组织内的邮件系统中能被识别处理。跨组织发送时，该属性无法转换为SMTP等标准邮件协议支持的字段，外部收件人的邮件客户端读取不到，所以到期设置无效。

可行解决方式：

• 显性标注到期信息：在邮件主题、正文里直接写明到期时间（你代码里已经做了类似处理），这是跨组织场景下最稳妥的方案，确保收件人能直观看到到期提示。
• 组织级邮件流规则：如果你的公司有Exchange管理员权限，可让管理员创建邮件流规则，对外部邮件添加自定义到期头或应用统一保留策略，但这属于管理员操作范畴，无法通过个人VBA实现。

二、用VBA设置邮件保留期限 #

Outlook单邮件的保留期限可通过调用MAPI属性实现，以下是修改后的完整代码示例：

带保留期限设置的VBA代码 #

Sub testEmailWithRetention()
    Dim OutlookApp As Outlook.Application
    Dim myMsg As Outlook.MailItem
    Dim objPropertyAccessor As Outlook.PropertyAccessor
    
    ' 定义保留期限相关的MAPI属性
    Const PR_RETENTION_PERIOD As String = "http://schemas.microsoft.com/mapi/proptag/0x30180003"
    Const PR_RETENTION_FLAGS As String = "http://schemas.microsoft.com/mapi/proptag/0x30190003"
    Const PR_RETENTION_DATE As String = "http://schemas.microsoft.com/mapi/proptag/0x301A0040"
    
    Set OutlookApp = New Outlook.Application
    Set myMsg = OutlookApp.CreateItem(olMailItem)
    Set objPropertyAccessor = myMsg.PropertyAccessor
    
    ' 附件添加逻辑保持不变
    If Sheet5.Cells(2, Sheet5.Range("FileShareLocation").Column) = "" _
      Or Sheet5.Cells(2, Sheet5.Range("AttachOverride").Column) = "Yes" _
      Then
        If Sheet5.Cells(2, Sheet5.Range("ZipFile").Column) = "Yes" Then
            myMsg.Attachments.Add strSaveToPath & strFileNameZip
        Else
            myMsg.Attachments.Add strSaveToPath & strFileName
        End If
    End If
    
    strSubject = "Test - expires " & Now + 30
    strBody = "Hello," & "<br><br>" & "Test - expires " & Now + 30
    
    With myMsg
        .BodyFormat = olFormatHTML
        .Display
        .HTMLBody = strBody & .HTMLBody
        .To = "Test@Test.com"
        .Subject = strSubject
        .ExpiryTime = Now + 30 ' 对内部收件人依然生效
        
        ' 设置30天保留期限（需Exchange/Office 365支持）
        objPropertyAccessor.SetProperty PR_RETENTION_PERIOD, 30 ' 保留天数
        objPropertyAccessor.SetProperty PR_RETENTION_FLAGS, 1 ' 启用保留规则
        objPropertyAccessor.SetProperty PR_RETENTION_DATE, Now + 30 ' 保留到期日期
        
        .CC = ""
        .BCC = ""
        '.Send
    End With
    
    ' 释放对象
    Set objPropertyAccessor = Nothing
    Set myMsg = Nothing
    Set OutlookApp = Nothing
End Sub

注意事项 #

• 保留期限功能依赖Exchange/Office 365的保留策略支持，需要你的邮箱账户所在组织启用了相关服务，且该属性仅对内部邮件或使用Exchange系统的外部收件人生效。
• 若要确保外部非Exchange收件人也能处理到期逻辑，仍需在邮件正文明确提示，并建议收件人通过自身邮件客户端规则设置自动删除。

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