Question

我正在寻找一种通过Outlook 2013中的VBA代码加密Outlook邮件的方法。该makro将加密并发送邮件。

我希望我可以简单地访问邮件对象，简单地称之为“加密”-Method，但遗憾的是微软说，“Microsoft Outlook对象模型不提供直接支持以编程方式签名或加密邮件“，但有可能为它建立一个解决方案。（https://support.microsoft.com/de-de/help/2636465/how-to-sign-or-encrypt-mail-messages-programmatically）

有没有人有一个想法/代码片段如何解决我的问题或在哪里查找？我知道我可以通过Outlook手动加密邮件，但我想以编程方式访问它。也许我可以简单地调用像事件或设置此属性时调用的东西。

感谢您的帮助和建议:)！

编辑：我没有可以使用的任何证书，是否有办法在不使用证书的情况下加密Outlook中的邮件？

Answer 1

您需要设置PR_SECURITY_FLAGS属性。有关示例，请参阅https://blogs.msdn.microsoft.com/dvespa/2009/03/16/how-to-sign-or-encrypt-a-message-programmatically-from-oom/。

Answer 2

令人惊讶地很难找到此信息。如果以上链接消失，则此函数可实现设置PR_SECURITY_FLAGS属性。

'---------------------------------------------------------------------------------------
' Procedure : Mailitem_SignEncr
' Date      : 2019-06-11
' Author    : Andre 
' Purpose   : Set security flags for an Outlook Mailitem
'
' Source: https://blogs.msdn.microsoft.com/dvespa/2009/03/16/how-to-sign-or-encrypt-a-message-programmatically-from-oom/
' Parameters:
' oItem: If your code runs in Outlook VBA, you can use this to get the current mail: Set oItem = Application.ActiveInspector.CurrentItem
'        Otherwise you get this object when creating the new mail item.
' doSign: Digital Signature. +1 = ON, -1 = OFF, 0 = leave default
' doEncr: Encryption.        +1 = ON, -1 = OFF, 0 = leave default
'---------------------------------------------------------------------------------------
'
Public Sub Mailitem_SignEncr(oItem As Outlook.MailItem, doSign As Long, doEncr As Long)

    Const PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003"
    Const SECFLAG_ENCRYPTED As Long = &H1
    Const SECFLAG_SIGNED As Long = &H2

    Dim SecFlags As Long

    ' Get current flags value
    SecFlags = oItem.PropertyAccessor.GetProperty(PR_SECURITY_FLAGS)

    ' Turn flags on/off

    If doSign > 0 Then
        ' ON
        SecFlags = SecFlags Or SECFLAG_SIGNED
    ElseIf doSign < 0 Then
        ' OFF
        SecFlags = SecFlags And (Not SECFLAG_SIGNED)
    Else
        ' leave this flag as it is
    End If

    If doEncr > 0 Then
        SecFlags = SecFlags Or SECFLAG_ENCRYPTED
    ElseIf doEncr < 0 Then
        SecFlags = SecFlags And (Not SECFLAG_ENCRYPTED)
    End If

    ' and set the modified flags
    oItem.PropertyAccessor.SetProperty PR_SECURITY_FLAGS, SecFlags

End Sub

通过VBA以编程方式加密Outlook邮件

2 个答案: