Question

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

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

有没有办法使用vba来抑制该警告，以便发送电子邮件时没有任何问题？

Answer 1

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

缺点是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发送消息时失败，虽然我曾经在系统特别慢时看到警告消息，经调查后发现该消息已被发送。

Answer 2

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

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

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

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

Answer 3

几年前我在互联网上的某个地方找到了代码。它自动回答“是”＆＃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

Answer 4

窗口正在弹出，因为宏没有受信任的发布者签名。 Outlook设置中的此列表。您必须对宏进行签名并将签名者输入您的受信任发布者列表。或者全局允许使用未签名的宏。

Answer 5

一些选项：

使用最新的防病毒软件（然后Outlook将不会显示提示）
扩展的MAPI（仅C ++或Delphi，不适用于VB脚本或.Net语言）。不过，您可以使用Redemption之类的包装程序，该包装程序使用扩展MAPI，但可以从任何语言（包括VBS）进行访问。
ClickYes之类的产品。

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

Answer 6

此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

Answer 7

添加到朱莉娅·格兰特的答案和回答酱

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

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

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

7 个答案: