使用 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

除了评论中link 中描述的方法外，假设您是发件人“...要求我允许或拒绝”，如果您正在运行 Excel，则可以已经拥有 Outlook strong> 也在运行。

最简单的方法是：

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