如何在excel中使用macros发送邮件时禁用Outlook警告
我想在Excel中使用macros发送电子邮件。
但是，当我运行这个代码我的邮件客户端，即MS Outlook显示popup类似的警告
Someone is tying to send mail on behalf of you. select yes or no
有没有什么办法使用VBA压制这个警告，所以电子邮件应该没有任何问题发送？
我知道的最好的方法是创build一个Outlook应用程序项目，创build消息，显示消息并使用sendkeys发送消息（等同于键入alt s）。
缺点是sendkeys方法可能有点bug。 为了使它更加健壮，我得到邮件项目的检查员，即它所在的窗口，并在调用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
我通常有代码来检查已发送的文件夹中的项目数量是否增加，如果没有，我会再次等待应用程序并重复最后两行代码，并重新检查发送文件夹中的消息数量是否增加。 代码可以达到5次。 第五次后，一个消息框出现警告消息可能没有被发送。
我从来没有发现这个方法不能从excel发送消息失败，尽pipe当我们的系统特别慢的时候我看到了这个警告消息，调查结果是这个消息已经发送了。
您需要使用Redemption DLL来禁用此警告…
下载http://www.dimastr.com/redemption
我创build了一种方法来安装在机器上的DLL自动，你可以尝试…
http://www.officevb.com/2011/02/copiando-e-registrando-componentes-na.html
几年前，我在互联网上的某个地方find了代码。 它会自动为您答复“是”。
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
该窗口popup，因为该macros没有由受信任的发布者签名。 这个列表在你的Outlook设置中。 您必须签署macros并将签名者input到您信任的发布者列表中。 或者全局允许未签名的macros。