Hello Excel community,

I'm looking for help with creating VBA code to add security features to attachments in Outlook. Specifically, I'm interested in adding watermarking, encryption, expiration/revocation, and tracking features to attachments using VBA code. I know, it is possible to set the watermarking for the attachment in bulk emails sent from Excel. We can use VBA code to automate the process of adding a watermark to each attachment in the Excel file.

For watermarking, I understand that I can add a custom property to the attachment that includes a unique identifier. For encryption and key management, I plan to use the built-in encryption features in Outlook to encrypt the attachment and assign unique decryption keys to each recipient. For expiration and revocation, I believe that I can use VBA code to set an expiration date on the attachment or revoke access at any time.

However, I'm also interested in creating a log or database of the unique identifiers for each attachment, along with the corresponding recipient, to help track the distribution of attachments and identify the original recipient in case of unauthorized sharing or distribution. I plan to store this log or database in Excel, but I'm open to other formats as well.

If anyone in the community has experience with creating VBA code for these types of security features in Outlook, I would greatly appreciate your assistance. Specifically, I'm looking for guidance on the specific VBA code that I'll need to add these features to attachments, as well as any advice on how to store and manage the log or database of unique identifiers.

Thank you in advance for your help, and please let me know if you need any additional information or resources from me to assist with this question.

Best regards,
Pankaj Jaswani

As I am not a professional VBA expert, I have come across some code that may be helpful to you, but I am unable to do it myself at this time.

For watermarking:

Sub AddCustomProperty()
    Dim item As Outlook.MailItem
    Set item = Application.ActiveInspector.CurrentItem
    If item.Attachments.Count > 0 Then
        Dim attachment As Outlook.Attachment
        Set attachment = item.Attachments(1)
        attachment.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/string/{00020386-0000-0000-C000-000000000046}/MyCustomProperty", "Unique Identifier"
    End If
End Sub
For encryption and key management:

Sub EncryptAndAssignKeys()
    Dim item As Outlook.MailItem
    Set item = Application.ActiveInspector.CurrentItem
    item.Encrypt
    Dim recipient As Outlook.Recipient
    For Each recipient In item.Recipients
        recipient.EncryptedContent = True
        recipient.AutoResponse = olAutoResponseSuppress
    Next recipient
End Sub
For expiration and revocation:

Sub SetExpirationDate()
    Dim item As Outlook.MailItem
    Set item = Application.ActiveInspector.CurrentItem
    item.ExpiryTime = Now() + 7 ' Set expiration date 7 days from now
End Sub
To revoke access to a message:

Sub RevokeAccess()
    Dim item As Outlook.MailItem
    Set item = Application.ActiveInspector.CurrentItem
    item.Delete
End Sub