vba 如何在excel中使用宏发送邮件时抑制Outlook警告

How can I supress the Outlook warning while sending mail using macro in excel

提问by Anurag Rana

I am trying to send an email using macro in excel.

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

But when I run this code my mail client i.e. MS Outlook shows a pop up warning similar to
Someone is tying to send mail on behalf of you. select yes or no

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

Is there any way using vbato suppress that warning so the email should be sent without any problem?

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

采纳答案by Graham Anderson

The best way I know is to create an outlook application item, create the message, display the message and use sendkeys to send the message (equivelent of typing alt s).

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

The drawback is that the sendkeys method can be a bit buggy. To make it more robust I get the inspector for the mail item i.e. the window it is in and activate it immediately prior to the call to sendkeys. The code is shown below:

缺点是 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

I normally then have code to check that the number of items in the sent folder has increased and if not I get the application wait again and repeat the last 2 lines of code and recheck that the number of messages in the sent folder has increased. The code does this upto 5 times. After the 5th time a message box comes up warning that the message may not have been sent.

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

I have never found this method to fail in sending a message from excel though I once saw the warning message when our system was particularly slow, on investigation it turned out that the message had been sent.

我从来没有发现这种方法在从excel发送消息时失败，尽管我曾经在我们的系统特别慢时看到警告消息，经调查发现消息已发送。

回答by Bruno Leite

You need use a Redemption DLL to disable this warning...

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

Download http://www.dimastr.com/redemption

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

I Created one way to install this DLL on machine automatic, you can try...

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

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

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

回答by Hassaan AlAnsary

Adding to Julia Grant's Answer and Answering dsauce

添加朱莉娅格兰特的回答和回答 dsauce

When used Julia' Code directly I got the error RegisterWindowMessageThis should be fixed by replacing Private Declare Functionwith Declare PtrSafe Functionin the declaration section

直接使用 Julia' Code 时出现错误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 = " <[email protected]>;  <[email protected]"
    .Subject = "Your Subject Here"
    .HTMLBody = "Your message body here"
    .Send
End With

TurnOffAutoYes '*** Add this after your email has been sent


End Function

I know the thread is old, but it may help somebody

我知道线程很旧，但它可能对某人有所帮助

回答by Keith Swerling

This Outlook VBA will load an excel file with emails stored as records and send all of them.

此 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

回答by Julia Grant

I found the code below somewhere on the internet a couple of years ago. It automatically answers 'Yes' for you.

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

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 = " <[email protected]>;  <[email protected]"
    .Subject = "Your Subject Here"
    .HTMLBody = "Your message body here"
    .Send
End With

TurnOffAutoYes '*** Add this after your email has been sent


End Function

回答by kyle

the window is popping up to begin with because the macro is not signed by a Trusted Publisher. This list in your Outlook settings. You must sign the macro and input the signer into your trusted publishers list. Or allow unsigned macros globally.

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

回答by Dmitry Streblechenko

A few options:

几个选项：

1. Use up-to-date antivirus software (Outlook will not display a prompt then)
2. Extended MAPI (C++ or Delphi only, does not apply in case of VB script or .Net languages). You can however use a wrapper like Redemptionthat uses Extended MAPI but is accessible from any language including VBS.
3. A product like ClickYes.

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

See http://www.outlookcode.com/article.aspx?id=52for a discussion and a list of available options.

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