![](/img/trans.png)
[英]How to encrypt an outlook mail created from Excel VBA (in Outlook > options > Encrypt)
[英]Encrypt Outlook Mail Programmatically via VBA
我正在寻找一种通过 Outlook 2013 中的 VBA 代码加密和发送 Outlook 邮件的方法。
我希望我可以访问邮件对象并调用类似“加密”的方法。
微软表示,“Microsoft Outlook 对象模型不提供直接支持以编程方式签署或加密邮件消息”,但可以为其构建解决方案。 ( https://support.microsoft.com/de-de/help/2636465/how-to-sign-or-encrypt-mail-messages-programmatically )
我知道我可以手动加密邮件,但我想以编程方式访问它。 也许我可以像事件一样调用,或者在设置此属性时调用的东西。
我没有任何证书。 有没有办法在不使用证书的情况下加密 Outlook 中的邮件?
您需要设置 PR_SECURITY_FLAGS 属性。 有关示例,请参阅https://blogs.msdn.microsoft.com/dvespa/2009/03/16/how-to-sign-or-encrypt-a-message-programmatically-from-oom/ 。
这个信息出奇地难找。 如果上面的链接失效,这里是一个实现设置 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.