vba - 受信メールのデジタル署名の保存方法

Question

現在開いているメール アイテムのデジタル署名を保存しようとしています。

今、Outlook が新しい電子メールをプログラムで暗号化/署名するためのアクセスを妨げていることに気付きました。ここでは、受信したメッセージに焦点を当てています。

これまでのところ、MessageClass プロパティを使用して署名付きメールを検出することしかできません。

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = CreateObject("Outlook.Application")
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
        Case Else
            ' anything else will result in an error, which is
            ' why we have the error handler above
    End Select

    Set objApp = Nothing
End Function

Sub DoExport()
    Set CurrentItem = GetCurrentItem()
    If CurrentItem.MessageClass = "IPM.Note.SMIME.MultipartSigned" Then
        MsgBox CurrentItem.MessageClass 
    End If
End Sub