Outlook 2010邮件数字签名验证异常问题求助

听起来你遇到的核心问题是Outlook规则触发脚本的时机过早——当规则执行时，Outlook可能还在后台完成签名邮件的验证和属性同步工作，这时候读取PR_SECURITY_FLAGS得到的是初始值0，导致已签名邮件被误移到NOSIG文件夹。Application.Wait没用是因为它只是阻塞线程，而Outlook的后台处理并没有在这段时间内完成属性更新。

下面给你几个可行的解决方案：

方案1：改用ItemAdd事件替代规则触发 #

ItemAdd事件会在邮件完全投递到收件箱、所有属性（包括签名相关的）都同步完成后才触发，这时候读取PR_SECURITY_FLAGS就能得到正确的值。

实现步骤： #

1. 打开Outlook的VBA编辑器（Alt+F11），找到ThisOutlookSession模块
2. 粘贴以下代码：

Private WithEvents InboxItems As Items

Private Sub Application_Startup()
    Dim olNs As Namespace
    Dim Inbox As Folder
    
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set InboxItems = Inbox.Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal Item As Object)
    Dim PR_SECURITY_FLAGS As Integer
    Dim nosigFolder As Folder
    
    ' 只处理邮件项
    If TypeName(Item) <> "MailItem" Then Exit Sub
    
    On Error Resume Next
    Set nosigFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("NOSIG")
    On Error GoTo 0
    
    If nosigFolder Is Nothing Then
        MsgBox "NOSIG文件夹不存在，请先创建！", vbExclamation
        Exit Sub
    End If
    
    ' 读取Security-Flags属性
    PR_SECURITY_FLAGS = Item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x6E010003")
    
    ' 处理取模逻辑
    If PR_SECURITY_FLAGS > 32 Then
        PR_SECURITY_FLAGS = PR_SECURITY_FLAGS Mod 32
    End If
    
    ' 判断是否签名
    If PR_SECURITY_FLAGS = 2 Or PR_SECURITY_FLAGS = 3 Then
        ' 已签名，执行你的自定义逻辑
        Debug.Print "已签名邮件：" & Item.Subject
    Else
        ' 未签名，移动到NOSIG
        Item.Move nosigFolder
    End If
End Sub

3. 保存后重启Outlook，以后新邮件到达收件箱时会自动触发这个事件处理。

方案2：检查SMIME相关的其他属性 #

如果还是遇到属性读取异常，可以尝试检查另一个SMIME相关属性PR_SMIME_SIGNED（属性标签0x6E02000B），这个属性直接标记邮件是否被签名：

Dim isSigned As Boolean
isSigned = Item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x6E02000B")

If isSigned Then
    ' 已签名逻辑
Else
    ' 移动到NOSIG
End If

方案3：异步延迟处理（备选） #

如果必须使用规则触发，可以用Application.OnTime来实现异步延迟，避免阻塞Outlook的后台处理：
修改你的原脚本为：

Sub TRCR(MAIL_ITEM As MailItem)
    ' 延迟5秒后再处理，给Outlook足够时间同步属性
    Application.OnTime Now + TimeValue("00:00:05"), "'ProcessMail """ & MAIL_ITEM.EntryID & """'"
End Sub

Sub ProcessMail(entryID As String)
    Dim olNs As Namespace
    Dim mailItem As MailItem
    Dim PR_SECURITY_FLAGS As Integer
    Dim nosigFolder As Folder
    
    Set olNs = Application.GetNamespace("MAPI")
    On Error Resume Next
    Set mailItem = olNs.GetItemFromID(entryID)
    Set nosigFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("NOSIG")
    On Error GoTo 0
    
    If mailItem Is Nothing Or nosigFolder Is Nothing Then Exit Sub
    
    PR_SECURITY_FLAGS = mailItem.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x6E010003")
    
    If PR_SECURITY_FLAGS > 32 Then
        PR_SECURITY_FLAGS = PR_SECURITY_FLAGS Mod 32
    End If
    
    If PR_SECURITY_FLAGS = 2 Or PR_SECURITY_FLAGS = 3 Then
        ' 已签名逻辑
    Else
        mailItem.Move nosigFolder
    End If
    
    Set mailItem = Nothing
    Set olNs = Nothing
End Sub

这个方法通过EntryID重新获取邮件，确保读取的是最新的属性值。

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