Disable "a program is trying to..." message

[eriknokc]

When I run the macro below, I receive the message "A program is trying to automatically send e-mail on your behalf. Do you want to allow this?" My options are yes, no and help and the green progress bar has to go across the warning box before I can click yes. Is there a way to add code in the macro to disable or skip this?

Sub Send()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    Set rng = Sheets("Sheet1").Range("A7:D9").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

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

    On Error Resume Next
    With OutMail
        .To = "TEST"
        .CC = ""
        .BCC = ""
        .Subject = "TEST"
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[Leith Ross]

Hello eriknokc,

There are 2 options available. You can send the email using CDO (Collaboration Data Objects, previously known as Active Messaging) schema or rewrite the macro to run from Outlook. If you want to run the macro from Outlook you will have to create a digital signature and sign your project before you will be free of all the security b.s.

If you want to see how it is done using CDO, check out Ron De Bruin's site here

If you want a VBA example of sending the email from Outlook and how to create a digital signature, download the attached Zipped Word document.

[eriknokc]

Thanks for the information. When I do that I receive a runtime error -2147220960 (80040220) The "sendusing" configuration value is invalid

Option Explicit

'This procedure will mail the visible cells in the selection in the body of the mail.
'Select a few cells first before you run the code
'You can change it to send a fixed range or the whole worksheet if you want

'Set rng = Sheets("sheet1").Range("D4:D12").SpecialCells(xlCellTypeVisible)
'Set rng = ActiveSheet.UsedRange
'Set rng = Sheets("sheet1").UsedRange


Sub CDO_Send_Selection_Or_Range_Body()
    Dim rng As Range
    Dim iMsg As Object
    Dim iConf As Object
    '    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set rng = Sheets("sheet1").Range("B5:D13").SpecialCells(xlCellTypeVisible)
    Set rng = ActiveSheet.UsedRange
    Set rng = Sheets("sheet1").UsedRange

    '    iConf.Load -1    ' CDO Source Defaults
    '    Set Flds = iConf.Fields
    '    With Flds
    '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '        .Update
    '    End With


    Set rng = Nothing
    On Error Resume Next

    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    With iMsg
        Set .Configuration = iConf
        .To = "test"
        .CC = ""
        .BCC = ""
        .From = "test"
        .Subject = "This is a test"
        .HTMLBody = RangetoHTML(rng)
        .Send
    End With

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

[Leith Ross]

Hello eriknokc,

This is one of the drawbacks in using CDO. It is complicated by many factors. Perhaps this will help you understand what is happening with the field...

If the SMTP service is installed on the local computer, then the value defaults to cdoSendUsingPickup (1). Otherwise, if Microsoft Outlook Express is installed, the value defaults to cdoSendUsingPort (2) and the settings from the default account are used.

Field Values
cdoSendUsingPickup (1)

cdoSendUsingPort (2)

cdoSendUsingExchange (3)

smtpserverport Field
This field is only relevant when the SendUsing field is set to cdoSendUsingPort (2). The default is 25. What browser are you using? This can effect the port setting.

[eriknokc]

I am trying to use this code at work and so that makes sense why I am receiving this error. Thanks for your help in clearing that up.

[DonkeyOte]

CDO is my preference also but there are 2 other methods that have not been mentioned:

1 - Outlook Redemption see: http://www.dimastr.com/redemption/

2 - ClickYes (3rd Party) see: http://www.contextmagic.com/express-clickyes/
(the free version should be sufficient)

Myself, as I say I prefer CDO though I have used ClickYes (without issue) ... I found Redemption a little intense...

[silent_knight]

Hi,

I tried copying digital certificate to the required folder however I got an error while was not clearly understand as it said error only. I have attached the snapshot as well. I am using this on my office PC .Please assist me .

Regards,
Knight

Hello eriknokc,

There are 2 options available. You can send the email using CDO (Collaboration Data Objects, previously known as Active Messaging) schema or rewrite the macro to run from Outlook. If you want to run the macro from Outlook you will have to create a digital signature and sign your project before you will be free of all the security b.s.

If you want to see how it is done using CDO, check out Ron De Bruin's site here

If you want a VBA example of sending the email from Outlook and how to create a digital signature, download the attached Zipped Word document.