VBA automated emails - How do I disable Microsoft outlook 'pop up'? 1

[VbPanicStation]

I have written a program in VBA ACCESS which is meant to send out automated emails via outlook. The problem is that when ever I run the program, a pop up is displayed which reads 'A program is trying to automatically send e-mail on your behalf. Do you want to allow this? If this is unexpected, it may be a virus and you should choose 'No'. Yes, No & Help options are given.

How can I disable this 'pop up' from within the VBA program? As different users are going to use the program, I can not rely on them to press yes.

PLEASE HELP

 

[Zion7]

I personally, have not found a VBA solution,
with the minimal research I did.
there are 3rd party utilities (I haven't tried),
that claim that can override it???

Do a google on "A program is trying to send....

 

[smedvid]

Look at ClickYes and Redemption as (2) possible solutions. htwh,

Steve Medvid
"IT Consultant & Web Master"

http://www.saveourfarm.com

Chester County, PA Residents
Please Show Your Support...

 

[jrbarnett]

An alternative is to send via SMTP and store the message contents in a table. For example

http://www.paulsadowski.com/WSH/cdo.htm

- this is easily adapted to run via Access VBA.

John

 

[smedvid]

CDO would be a preference instead of using a 3rd party in my opinion. I use CDO in the SQL Server realm for SMTP Emails... Good suggestion.

Steve Medvid
"IT Consultant & Web Master"

http://www.saveourfarm.com

Chester County, PA Residents
Please Show Your Support...

 

[jrbarnett]

As a quick example of adapting that code:

Public Function SendEmail()

    Dim strSMTPHost As String
    Dim intSMTPPort As Integer
    Dim strMessage As String
    Dim strTargetEmail As String
    Dim strSubject As String
    
    Dim objMessage
    
    strSMTPHost = "smtp.somewhere.com" ' SMTP Mail host
    intSMTPPort = 25     ' SMTP mail port
    strMessage = "" ' initialise the message text to nothing.
    strTargetEmail = "myemail at somewhere.com" ' email address as from: and to: but can be separated. Replace with proper address to combat spam harvesters.
    strSubject = "Test Email"

    strMessage = "Hello Email World"
    Set objEmail = CreateObject("CDO.Message")
    With objEmail
        .From = strTargetEmail
        .To = strTargetEmail
        .Subject = strSubject
        .Textbody = strMessage
        .Configuration.Fields.Item _
        ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2 ' 2 = remote server, not local.
        .Configuration.Fields.Item _
        ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = strSMTPHost ' DNS name of SMTP mail server host. Can use FQDN instead
        .Configuration.Fields.Item _
        ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = intSMTPPort
        .Configuration.Fields.Update
        .Send
    End With
    
End Function

Use the .HTMLBody property to use HTML email rather than plain text as above.

John

 

[Zion7]

jBarnett, thank-you very much for that insight.
I couldn't get your code to work, without setting the
password & username codes.
So in case anyone is having a similiar problem,
here's possibly a solution, Thanks again John!

Sub EmailCDO()
'Set reference to 'Microsoft CDO fior Windows 2000'
'Bypasses Outlook warning Msg "Someone Is Attempting to send a message..."
On Error GoTo xxx

Dim iMsg As CDO.Message, iConf As CDO.Configuration, Flds

Const cdoSendUsingPort = 2

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

Set Flds = iConf.Fields

' Set the CDOSYS configuration fields to use port 25 on the SMTP server.

With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "smtp.broadband.rogers.com"
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUserName) = "frfrs@rgers.com"
.Item(cdoSendPassword) = "*****"
.Update
End With

' Apply the settings to the message.
With iMsg
Set .Configuration = iConf
.To = "frfrs@rgers.com"
.From = "frfrs@rgers.com"
.Subject = "This is a test CDOSYS message (Sent via Port 25)"
.AddAttachment ("C:\Documents and Settings\Dan\My Documents\FSXPaymentPlan.txt")
.sEnd
End With

'
xx:
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
Exit Sub
xxx:
MsgBox Err & vbCrLf & Error$, , "Sub; EmailCDO"
Resume xx
End Sub