How to avoid the Outlook security warning for email automation?

Question

I'm trying to send an Outlook email from Excel 2010 using VBA.

Most answers on Stack Overflow don't seem to have a method of using VBA to avoid the Outlook security warning, nor for Outlook/Excel 2010.

Do any free methods exist? The Redemption method won't be a viable option, unless it is easy to install on 10 machines in a large company.

How I send emails:

Dim emailAddr As String
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = "[email protected]"
    .Subject = "Demande"
    .HtmlBody = CombinedValueHtml
    .Send
End With
  
Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

Answer 1

This is a partial answer. I have made it a Community Wiki answer in the expectation that someone else can explain the final part which I cannot get to work.

This web page, http://msdn.microsoft.com/en-us/library/office/aa155754(v=office.10).aspx , explains the first three parts of the process. It was written in 1999 so cannot be followed exactly because it refers to old versions of Windows and Office.

The first step is to add Digital Signature for VBA Projects to your Office installation although I found it under Shared Tools rather than Office Tools. Don't make the mistake of just adding Digital Signature for VBA Projects to Outlook because, as I discovered, that means you uninstall Word, Excel, etc.

The second step is to run Selfcert.exe to create a digital certificate in your own name.

The third step is to open Outlook's VBA editor, select Tools then Digital Certificate then Choose to sign the project with your certificate.

With these steps you can suppress the warning that Outlook contains macros but this does not suppress that warning that a macro is accessing emails. To suppress that warning, you need a fourth step which is to place your certificate within the Trusted Root Certificate Authorities Store. This web page http://technet.microsoft.com/en-us/library/cc962065.aspx explains about the Certification Authority Trust Model but I cannot successfully use Microsoft Management Console to achieve the fourth step.

Answer 2

Instead .send use the following:

.Display 'displays outlook email
Application.SendKeys "%s" 'presses send as a send key

note: be careful when using display keys, if you move the mouse and click while the program is running it can change whats going on. also outlook will display on ur screen and send.. if you working on something else's and this bothers you, yea.. not the best idea

Answer 3

The Redemption method won't be a viable option, unless it is easy to install on 10 machines inside of a large company.

You can use RedemptionLoader (I am its author) - it loads the dll directly and does no require the dll to be installed using the registry.

It is either Extended MAPI in C++ or Delphi, Redemption (I am its author - wraps Extended MAPI and can be used form any language) or a utility like ClickYes.

Answer 4

If you don't send the message immediately but just display it and let the user do modifications (if any) and let them press the send button theirselves, this would work:

i.e. use

.Display

instead of

.Send

Answer 5

I explained how you can use vba to send emails in this answer You will find a macro that I use extensively in my daily work.

Following recomendations from @Floern, here is the explanation:

In order to insert images (signature as images) you could use the following code:

Step 1. Copy this code an paste in class module and name that class module like "MailOptions"

Private Message As CDO.Message
Private Attachment, Expression, Matches, FilenameMatch, i

Public Sub PrepareMessageWithEmbeddedImages(ByVal FromAddress, ByVal ToAddress, ByVal Subject, ByVal HtmlContent)

    Set Expression = CreateObject("VBScript.RegExp")
    Expression.Pattern = "\<EMBEDDEDIMAGE\:(.+?)\>"
    Expression.IgnoreCase = True
    Expression.Global = False 'one match at a time

    Set Message = New CDO.Message
    Message.From = FromAddress
    Message.To = ToAddress
    Message.Subject = Subject

    'Find matches in email body, incrementally increasing the auto-assigned attachment identifiers
    i = 1
    While Expression.Test(HtmlContent)
        FilenameMatch = Expression.Execute(HtmlContent).Item(0).SubMatches(0)
        Set Attachment = Message.AddAttachment(FilenameMatch)
        Attachment.Fields.Item("urn:schemas:mailheader:Content-ID") = "<attachedimage" & i & ">" ' set an ID we can refer to in HTML
        Attachment.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline" ' "hide" the attachment
        Attachment.Fields.Update
        HtmlContent = Expression.Replace(HtmlContent, "cid:attachedimage" & i) ' update the HTML to refer to the actual attachment
        i = i + 1
    Wend

    Message.HTMLBody = HtmlContent
End Sub

Public Sub SendMessageBySMTP(ByVal SmtpServer, ByVal SmtpUsername, ByVal SmtpPassword, ByVal UseSSL)
    Dim Configuration
    Set Configuration = CreateObject("CDO.Configuration")
    Configuration.Load -1 ' CDO Source Defaults
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SmtpServer
    'Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SmtpPort
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30

    If SmtpUsername <> "" Then
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SmtpUsername
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SmtpPassword
    End If
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = UseSSL
    Configuration.Fields.Update
    Set Message.Configuration = Configuration
    Message.Send
End Sub

Step 2. In an standar module you will elaborate your .html content and instantiate a object from the class:

public sub send_mail()

Dim signature As String
dim mail_sender as new MailOptions 'here you are instantiating an object from the class module created previously
dim content as string

signature = "C:\Users\your_user\Documents\your_signature.png"

content = "<font face=""verdana"" color=""black"">This is some text!</font>"
content = content & "<img src=""<EMBEDDEDIMAGE:" & signature & " >"" />"

mail_sender.PrepareMessageWithEmbeddedImages _
                    FromAddress:="[email protected]", _
                    ToAddress:="[email protected]", _
                    Subject:="your_subject", _
                    HtmlContent:=content

'your_Smtp_Server, for example: RelayServer.Contoso.com
correos.SendMessageBySMTP "your_Smtp_Server", "your_network_user_account", "your_network_user_account_password", False

end sub