vba 在没有安全警告的情况下使用 Outlook 从 Excel 发送电子邮件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21026491/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Sending emails from Excel using Outlook without security warning
提问by user2800204
I am using code from Ron de Bruin's website to send emails through Excel using Outlook. I get this security warning "A program is trying to send e-mail message on your behalf" asking me to allow or deny.
我正在使用 Ron de Bruin 网站上的代码使用 Outlook 通过 Excel 发送电子邮件。我收到此安全警告“程序正试图代表您发送电子邮件”，要求我允许或拒绝。
How can I avoid this warning and send emails directly"
如何避免此警告并直接发送电子邮件”
Note: I am using Excel 2007.
注意：我使用的是 Excel 2007。
Here is the code:
这是代码：
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 = " [email protected]"
.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
回答by niton
In addition to the methods described in the linkfrom the comment, assuming you are the sender "...asking me to allow or deny", if you have Excel running you can have Outlook alreadyrunning as well.
除了方法中所描述的链接从评论，假设你是发送者“......要求我允许或拒绝”，如果你有运行Excel，你可以让Outlook已经运行也是如此。
The simplest way would be:
最简单的方法是：
Set OutApp = GetObject(, "Outlook.Application")
回答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
