E-mail Alert Message

[farmock]

I am using Ron DeBruin's code to automatically send a file via an attachment to an e-mail message as follows:

Sub Mail_workbook_Outlook()
'This example send the last saved version of the Activeworkbook
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


I am using Outlook and it is working OK except I am getting a Microsoft Outlook Alert as follows:

A program is automatically trying to send an e-mail on your behalf. Do you want to allow this?

I have tried setting DisplayAlerts to false but it doesn't prevent it. Can anybody tell me how to prevent the alert? Thanks in advance Frank

 

[Smitty]

Welcome to the Board!

Check out this link on Outlook Redemption.

And this one by Sue Mosher, Outlook MVP.

Hope that helps,

Smitty

 

[Joe Was]

This is a rather new security patch put in by Microsoft to help stop worms and the like.

No direct way to stop it.

Two things you can do though, use SendKeys to answer the Message automatically like:


Sub Mailer()
'Mails without security alert

'Need reference to Outlook in the Project References

Dim objol As New Outlook.Application
Dim objmail As MailItem
Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)
Dim strbody As String
Dim pathname As String

strbody = "Enter Subject Body Here"
pathname = "Pathname of Attachment"

With objmail
'Email To = Email Address in quotes
.To = "Email Address Here"
.CC = "Email Address Here"

.Subject = "Subject" '
'Message Body
.Body = "Message Body" & _
vbCrLf & vbCrLf & strbody & _
vbCrLf & vbCrLf & "Kind Regards" & vbCrLf & _
vbCrLf & "Your Name" & vbCrLf & "Job Title"
'Does not Expire
.NoAging = True
'Read Receipt
.ReadReceiptRequested = True

'adds attachment to email
.Attachments.Add pathname

'Display Email
.Display
End With
Set objmail = Nothing
Set objol = Nothing

'Used for Sending Email Automatically
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Application.Wait (Now + TimeValue("0:00:02"))

SendKeys "%{s}", True 'send the email without prompts

End Sub


Or use the .com addin:

http://www.dimastr.com/redemption/

 

[farmock]

Email

Joe,
Thanks for the help. Frank

 

[nehpets12]

http://www.contextmagic.com/express-clickyes/

Try this little software programe it free and works!!!