asked on

Encrypt Outlook Email from MS Access

I'm using the below code to send Outlook emails from MS Access. I would like to encrypt the email using vba ... maybe enable the encryption button on the ribbon.

    Dim sMail                 As String
    Dim objOutlook            As Object
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String
    Dim strName               As String
    Dim sSubj                 As String
    Dim sBody                 As String
    Dim sTo                   As String
    Dim strCC                 As String
    Dim sCC                   As String
   
   
  

    'Get Email Addres
    sSQL = vbNullString
    sSQL = sSQL & "SELECT   tblTempShipNotice.Email," & vbCrLf
    sSQL = sSQL & "         tblTempShipNotice.Lname," & vbCrLf
    sSQL = sSQL & "         Concatenate(""SELECT Emails FROM tblFO WHERE FO='"" & Nz([FO],""~999"") & ""';"","";"") AS CCEmails," & vbCrLf
    sSQL = sSQL & "         tblTempShipNotice.Adjudicator" & vbCrLf
    sSQL = sSQL & "FROM tblTempShipNotice;"

    Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            Set objOutlook = CreateObject("Outlook.Application")
            Do While Not .EOF
                'Initialize the variable for each loop
                strName = ""
                sMail = ""
                sSubj = ""
                
                'Populate the variables with our record data
                strName = Nz(rs![Adjudicator], "")
                sMail = sMail & ";" & Nz(rs("Email"), "")
                strCC = Nz(rs![CCEmails], "")
                If strCC <> "" Then strCC = strCC & ";"
                
                Dim filePath As String
                filePath = vbNullString
                If (rs("Adjudicator") & vbNullString <> vbNullString) Then
                    filePath = CurrentProject.Path & "\Exports\" & rs("Adjudicator") & ".xlsx"
                End If
                Call Outlook_SendEmailHold(objOutlook, sMail, strCC, sCC, sSubj, strName, filePath)

                .MoveNext
            Loop
            Set objOutlook = Nothing
        End If
          Exit Sub
 
    End With
    End If
    
Exit_Err_Handler:

Exit Sub
Err_Handler:
DoCmd.Close acForm, "frmPleaseWait"
MsgBox Err.Number & " " & Err.Description & " Please Contact Administrator"
Resume Exit_Err_Handler

    
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

John Tsioumpris

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

David Johnson, CD

As John has pointed out there are several examples (this is one such example)
if you have s/mime setup and have the recipients public key

$PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003&quot;
$Outlook = New-object -ComObject Outlook.Application
$Mail = $Outlook.CreateItem(0)
$Mail.To = "mail@company.tld"
$Mail.Subject ="Test"
$Mail.Body ="Test Body"
# 0 = nix, 1 = encrypt, 2 = sign, 3 = both!
$Mail.PropertyAccessor.SetProperty($PR_SECURITY_FLAGS, 3)
#$Mail.Send()
$Mail.Display()

Open in new window

https://blogs.msdn.microsoft.com/dvespa/2009/03/16/how-to-sign-or-encrypt-a-message-programmatically-from-oom/

Adam Brown

if you have s/mime setup and have the recipients public key

Is the key here. S/MIME is extremely rare, due to the end-user overhead required to implement it. For it to work, the email addresses your are sending to must provide you with their private key in order to encrypt the message using the PR_SECURITYFLAGS tag. I can just about guarantee that almost none of the recipients you'll be sending to will have S/MIME capability. If you want to guarantee secure delivery, you'll need to utilize a third party secure messaging platform like Azure Information Protection for Office 365 Message Encryption (This requires a license for Exchange Online or Exchange Online Protection plus an Azure Information Protection license assigned to the sending email address, I have a guide here: https://acbrownit.com/2018/05/25/enabling-message-encryption-in-office-365/), ZixCorp's mail security, or Cisco Registered Envelope Service. If you have any of these, you can configure them to encrypt based on subject or body tags like [Encrypt], then configure your script to add that tag when necessary. This is about the only guaranteed way to get secure message delivery done reliably. S/MIME requires coordination between you and all client organizations to work. If it's not set up right, it'll fail.

David Johnson, CD

you with their private key change private to PUBLIC and you have it right, they also require your PUBLIC key

shieldsco

ASKER

what I would like to do is access the Office CommandBarButton and then find the encrypt message control and select it.

Adam Brown

you with their private key change private to PUBLIC and you have it right, they also require your PUBLIC key

yep. Typo.

what I would like to do is access the Office CommandBarButton and then find the encrypt message control and select it.

That will fail to encrypt and send the message unless you have s/mime configured. That's what we're trying to tell you. Outlook doesn't just encrypt messages and send them. It uses s/mime, which is a public key cryptography system, to encrypt and decrypt. S/mime can out work unless both side of an email transaction exchange public keys, which are use to encrypt the message. Once received, the private key is used to decrypt.

Unless you are set up with office 365 using azure information protection and o365 message encryption, that button is useless without the recipient key.