Sending emails from Excel using Outlook without security warning

Question

I am using code from Ron de Bruin's website to send emails through Excel using Outlook. I get this security warning "A program is trying to send e-mail message on your behalf" asking me to allow or deny.

How can I avoid this warning and send emails directly"

Note: I am using Excel 2007.

Here is the code:

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim cell As Range

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Sheets("" & Sheet & "").Select
With Sheets("" & Sheet & "")
    strbody = ""
End With

On Error Resume Next
With OutMail
    .To = " [email protected]"
    .CC = ""
    .BCC = ""
    .Subject = ""
    .Body = strbody
    .From = ""
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

' restore default application behavior
Application.AlertBeforeOverwriting = True
Application.DisplayAlerts = True
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True

Chequered

See the answer to a similar question here – Galumph

Does this answer your question? How can I avoid Outlook's security warning when sending email programmatically? – Quassia

Answer 1

In addition to the methods described in the link from the comment, assuming you are the sender "...asking me to allow or deny", if you have Excel running you can have Outlook already running as well.

The simplest way would be:

Set OutApp = GetObject(, "Outlook.Application") 

Ferrocene

Answer 2

I found the code below somewhere on the internet a couple of years ago. It automatically answers 'Yes' for you.

Option Compare Database
    ' Declare Windows' API functions
    Private Declare Function RegisterWindowMessage _
            Lib "user32" Alias "RegisterWindowMessageA" _
            (ByVal lpString As String) As Long

     Private Declare Function FindWindow Lib "user32" _
                Alias "FindWindowA" (ByVal lpClassName As Any, _
                ByVal lpWindowName As Any) As Long


    Private Declare Function SendMessage Lib "user32" _
            Alias "SendMessageA" (ByVal hwnd As Long, _
            ByVal wMsg As Long, ByVal wParam As Long, _
            lParam As Any) As Long


    Function TurnAutoYesOn()
    Dim wnd As Long
    Dim uClickYes As Long
    Dim Res As Long
    uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
    wnd = FindWindow("EXCLICKYES_WND", 0&)
    Res = SendMessage(wnd, uClickYes, 1, 0)

    End Function

    Function TurnOffAutoYes()
    Dim wnd As Long
    Dim uClickYes As Long
    Dim Res As Long
    uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
    wnd = FindWindow("EXCLICKYES_WND", 0&)
    Res = SendMessage(wnd, uClickYes, 0, 0)
    End Function


    Function fEmailTest()

    TurnAutoYesOn  '*** Add this before your email has been sent



    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
    With MailOutLook
        .To = " <[email protected]>;  <[email protected]"
        .Subject = "Your Subject Here"
        .HTMLBody = "Your message body here"
        .Send
    End With

    TurnOffAutoYes '*** Add this after your email has been sent

    End Function

Zoubek

Is this ClickYes application required? contextmagic.com/express-clickyes – Ferrocene

No, it is not. I have the blow in my declarations. Option Compare Database Public Declare Function RegisterWindowMessage _ Lib "user32" Alias "RegisterWindowMessageA" _ (ByVal lpString As String) As Long Public Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" (ByVal lpClassName As Any, _ ByVal lpWindowName As Any) As Long Public Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" (ByVal hwnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long – Zoubek

@JuliaGrant this still gives a compile error for Option Compare Database , do you have a fix for this? – Bred

Could you add those declarations to your answer here as well? – Disengagement