Encrypt Outlook Mail Programmatically via VBA

前端 未结 2 1552
南方客
南方客 2021-01-13 15:38

I am looking for a way to encrypt and send Outlook mail via VBA code in Outlook 2013.

I was hoping I could access the mail object and call something like an \"encryp

2条回答
  •  执笔经年
    2021-01-13 16:06

    This information is surprisingly hard to find. In case the above link dies, here is a function that implements setting the PR_SECURITY_FLAGS property.

    '---------------------------------------------------------------------------------------
    ' 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
    

提交回复
热议问题