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 也在运行。

最简单的方法是：

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

Answer 2

几年前我在互联网上的某个地方找到了代码。它自动回答“是”＆＃39;为了你。

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

使用Outlook从Excel发送电子邮件而没有安全警告

2 个答案: