Encrypting Outlook E-Mail (1 Viewer)

Public Function SendAMsg(UID As Long, OLSbj As String, OLTo As String, _
    OLCC As String, OLBdy As String, bEnc As Boolean) As Long

Dim OLApp As Outlook.Application        'ACCESS construct to allow us to bit-twiddle Outlook
Dim OLMsg As Outlook.MailItem           'a mail message within Outlook
Dim OLNS As Outlook.NameSpace           'need this to get to the MAPI name space
Dim OLFld As Outlook.MAPIFolder         'need this for sending mail
Dim OLIns As Outlook.Inspector          'need this to set encryption
Dim OLBar As Office.CommandBar          'make this a command-bar object
Dim OLEnc As Office.CommandBarButton
Dim OLSgn As Office.CommandBarButton

...

    Set OLApp = Nothing                 'start with simplest assumption
    
    On Error Resume Next                'block traps while we poke around
    Set OLApp = GetObject(, "Outlook.Application") 'find existing instance of Outlook
    On Error GoTo 0                     'remove the trap block

...

    OLNew = False                       'assume we found one
    If OLApp Is Nothing Then            'did we find an existing Outlook we could use?
        OLNew = True                    'no, have to create one, so ...
        Set OLApp = CreateObject("Outlook.Application")    'create a private apps object
    End If

...

    Set OLNS = OLApp.GetNamespace("MAPI")   'get into the namespace

    OLNS.Logon , , False, False         'we created or tested the app already

    Set OLFld = OLNS.GetDefaultFolder(olFolderOutbox) 'find the outbox folder

    Set OLMsg = OLFld.Items.Add(olMailItem)   'from which we will send a single mail message

...

    OLMsg.Importance = olImportanceHigh 'start populating the mail message
    OLMsg.To = OLTo                     'fill in first set of recipients
    OLMsg.cC = OLCC                     'fill in second set of recipients
    OLMsg.Subject = OLSbj               'fill in the message subject
    OLMsg.Body = OLBdy                  'fill in the message body
    OLMsg.BodyFormat = olFormatPlain    'make it totally plaintext

'    encrypt if requested to do so

    If bEnc = True Then                 'see if we even need to bother
                
        Set OLIns = OLMsg.GetInspector  'get the inspector so we can open the toolbars
        
        Set OLBar = OLIns.CommandBars("Standard")   'get to the standard toolbar
        
        Set OLEnc = OLBar.FindControl(, EncryptMsgCtrl) 'which has ENCRYPT and SIGNDIGITAL
        Set OLSgn = OLBar.FindControl(, DigitalSigCtrl)
        
        If Not OLSgn Is Nothing Then    'if we found it, ...
            If OLSgn.Enabled = True Then    'and if it is enabled, ...
                If OLSgn.State = msoButtonUp Then   'and if it is not already set, ...
                    OLSgn.Execute
                End If
            End If
        End If
        
        If Not OLEnc Is Nothing Then
            If OLEnc.Enabled = True Then
                If OLEnc.State = msoButtonUp Then
                    OLEnc.Execute
                End If
            End If
        End If
        
    End If                              'end - if we are going to encrypt the message

    OLMsg.Send                          'send it on its way