使用 Outlook 2013/Excel 2013 发送邮件

Question

I currently have a program that queues up emails to send in a spreadsheet and then sends them out through the Outlook application (Excel and Outlook are both 2013 versions).

When I run the program, it goes through without a problem, however when a coworker runs the program they continue to get the prompts that "A program is trying to send a message on your behalf" and then they have to allow or deny each one individually.

I have looked through different methods for addressing this from changing the registry (tried that and it did not change anything) to security settings (still nothing).

Is there a way to address this with VBA?

The current code is:

Sub SendEmail(what_address As String, subject_line As String, mail_body_message As String)

Dim olApp As Outlook.Application
Dim oAttach As Outlook.Attachment

Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem

Set olMail = olApp.CreateItem(olMailItem)

With olMail

.To = "ADDRESS"

.Subject = "SUBJECT"

.BodyFormat = olFormatHTML

.HTMLBody = mail_body_message

'.CC = "EMAIL"
.BCC = ""

.Importance = olImportanceHigh

.ReadReceiptRequested = True

.Send

End With

End Sub 

Thanks!

Answer 1

Short answer: install an up-to-date anti-virus app or use products like Redemption or ClickYes .

See http://www.outlookcode.com/article.aspx?id=52 for more options and detailed discussion.

Answer 2

From Ron's site instead of .Send

 .Display 
 Application.Wait (Now + TimeValue("0:00:02"))
 Application.SendKeys "%s"

This will just bring up the email and sendkeys Alt-S to send.