使用Outlook在没有安全警告的情况下从Excel发送电子邮件

Question

我正在使用Ron de Bruin网站上的代码来使用Outlook通过Excel发送电子邮件。 我收到此安全警告“程序正在尝试代表您发送电子邮件”，要求我允许或拒绝。

我如何避免此警告并直接发送电子邮件”

注意：我正在使用Excel 2007。

这是代码：

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

除了所描述的方法链接从评论，假设你是发送者“......要求我允许或拒绝”，如果你有运行Excel，你可以让Outlook 已经运行也是如此。

最简单的方法是：

Set OutApp = GetObject(, "Outlook.Application") 

Answer 2

几年前，我在互联网上的某个地方找到了下面的代码。 它会自动为您回答“是”。

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