Sending emails from Excel using Outlook without security warning - vba

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 = " email1#a.com"
.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

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")

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 = " <Receipient1#domain.com>; <Receipient2#domain.com"
.Subject = "Your Subject Here"
.HTMLBody = "Your message body here"
.Send
End With
TurnOffAutoYes '*** Add this after your email has been sent
End Function