如何在 Excel 中使用宏发送邮件时抑制 Outlook 警告答案

【问题标题】：How can I supress the Outlook warning while sending mail using macro in excel如何在 Excel 中使用宏发送邮件时抑制 Outlook 警告
【发布时间】：2013-04-16 14:09:06
【问题描述】：

我正在尝试使用 Excel 中的宏发送电子邮件。

但是当我运行此代码时，我的邮件客户端（即 MS Outlook）会显示类似于
Someone is tying to send mail on behalf of you. select yes or no 的弹出警告

有什么方法可以使用vba 来抑制该警告，以便可以毫无问题地发送电子邮件？

【问题讨论】：

能否请您发布您正在使用的代码？
见rondebruin.nl/win/s1/security.htm

标签： vba excel vba outlook

【解决方案1】：

我知道的最好的方法是创建一个 Outlook 应用程序项，创建消息，显示消息并使用 sendkeys 发送消息（相当于键入 alt s）。

缺点是 sendkeys 方法可能有点错误。为了使它更健壮，我得到了邮件项目的检查器，即它所在的窗口，并在调用 sendkeys 之前立即激活它。代码如下：

Dim olApp As outlook.Application
Dim objNS As Outlook.Namespace
Dim objMail As Outlook.MailItem
Dim objSentItems As Outlook.MAPIFolder
Dim myInspector As Outlook.Inspector

'Check whether outlook is open, if it is use get object, if not use create object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
End If

Set objNS = olApp.GetNamespace("MAPI")
objNS.Logon

'Prepare the mail object    
Set objMail = olApp.CreateItem(olMailItem)

With objMail
.To = <insert recipients name as string>
.Subject = <insert subject as string>
.Body = <insert message as string>
.Display   
End With

'Give outlook some time to display the message    
Application.Wait (Now + TimeValue("0:00:05"))

'Get a reference the inspector obj (the window the mail item is displayed in)
Set myInspector = objMail.GetInspector

'Activate the window that the mail item is in and use sendkeys to send the message
myInspector.Activate
SendKeys "%s", True

然后我通常有代码来检查已发送文件夹中的项目数量是否增加，如果没有，我让应用程序再次等待并重复最后 2 行代码并重新检查已发送文件夹中的邮件数量是否增加增加。该代码最多执行 5 次。第 5 次后会出现一个消息框，警告消息可能尚未发送。

我从来没有发现这种方法无法从excel发送消息，虽然我曾经在我们的系统特别慢的时候看到警告消息，经过调查发现消息已经发送。

【讨论】：

objMail.GetInspector 还存在吗？线上出现错误The item has been moved or deleted.

【解决方案2】：

您需要使用 Redemption DLL 来禁用此警告...

下载 http://www.dimastr.com/redemption

我创建了一种在机器上自动安装此 DLL 的方法，您可以尝试...

http://www.officevb.com/2011/02/copiando-e-registrando-componentes-na.html

【讨论】：

【解决方案3】：

添加到 Julia Grant 的答案和答题

当直接使用 Julia 的代码时，我得到了错误 RegisterWindowMessage 这应该通过将Private Declare Function 替换为Declare PtrSafe Function 来解决在声明部分

Option Compare Database
' Declare Windows' API functions
Declare PtrSafe Function RegisterWindowMessage _
        Lib "user32" Alias "RegisterWindowMessageA" _
        (ByVal lpString As String) As Long

 Declare PtrSafe Function FindWindow Lib "user32" _
            Alias "FindWindowA" (ByVal lpClassName As Any, _
            ByVal lpWindowName As Any) As Long


Declare PtrSafe 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

我知道这个帖子很旧，但它可能对某人有帮助

【讨论】：

这不是问题的完整答案 - 如果您没有完整答案，请不要发布答案。相反，您应该在获得代表后评论其他人的答案。
如您所见，我没有代表发表评论。所以我不得不将其发布为答案。我只是想用我的知识帮助人们。
解决方案是不要故意违反规则（这只会让你得到否决和版主的负面关注），解决方案是让足够的代表发表评论，同时发布完整的答案. StackOverflow 不是论坛。
感谢您的提醒。我会将朱莉娅的答案添加到我的答案中。很抱歉给您带来不便。

【解决方案4】：

由于宏未由受信任的发布者签名，因此窗口开始弹出。此列表在您的 Outlook 设置中。您必须对宏进行签名并将签名者输入到您信任的发布者列表中。或者全局允许未签名的宏。

【讨论】：

【解决方案5】：

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

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

【讨论】：

它说 RegisterWindowMessage 没有定义。你有管理这个的代码部分吗？谢谢。

【解决方案6】：

几个选项：

使用最新的防病毒软件（此时 Outlook 不会显示提示）
扩展 MAPI（仅限 C++ 或 Delphi，不适用于 VB 脚本或 .Net 语言）。但是，您可以使用像 Redemption 这样的包装器，它使用扩展 MAPI，但可以从包括 VBS 在内的任何语言访问。
类似ClickYes的产品。

有关讨论和可用选项列表，请参阅 http://www.outlookcode.com/article.aspx?id=52。

【讨论】：

【解决方案7】：

此 Outlook VBA 将加载一个 Excel 文件，其中包含存储为记录的电子邮件并发送所有这些文件。

Option Explicit

 Private Const xlUp As Long = -4162

Sub SendEmailsFromExcel()

    Dim xlApp As Object

    Dim isEmailTo As String    ' Col A
    Dim isSubject As String    ' Col B
    Dim isMessage As String    ' Col C

    Dim i As Integer
    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    Dim emailsMatrix As Variant

    Dim objWB As Object
    Dim objWs As Object
    Dim FileStr As String

    FileStr = "C:\Users\...\Documents\EmailsInExcel.xlsx"

    Set xlApp = CreateObject("excel.application")

    With xlApp
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set objWB = xlApp.Workbooks.Open(FileStr)
    Set objWs = objWB.Sheets(1)

    ' Matrix load:  A - Email Address, B - Subject, C - Body
    emailsMatrix = objWs.Range("A1:C" & xlApp.Cells(objWs.Rows.Count, "A").End(xlUp).Row)

    objWB.Close

    Set objWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing

'   Done getting Excel emails file.

    For i = 1 To UBound(emailsMatrix)
        isEmailTo = emailsMatrix(i, 1)
        isSubject = emailsMatrix(i, 2)
        isMessage = emailsMatrix(i, 3)


        objMsg.Recipients.Add isEmailTo
        objMsg.Subject = isSubject
        objMsg.Body = isMessage
        objMsg.Send
    Next i

End Sub

【讨论】：

【解决方案8】：

我检查了很多方法，但这是最好的。

您只需要创建 Excel 的最小化窗口代码，然后将其最大化以便工作，并在脚本点击“发送”后添加一点延迟。

请确保在运行时不要触摸任何鼠标或键盘。我每天可以自动发送 25 多封没有错误的电子邮件。

'Excel Minimized
     ActiveWindow.WindowState = xlMinimized

'Outlook Email Shown
     .Display
     Application.Wait (Now + TimeValue("0:00:02"))
     Application.SendKeys "%s"
     Application.Wait (Now + TimeValue("0:00:01"))

'Excel Maximized
     ActiveWindow.WindowState = xlMaximized

【讨论】：