如何避免电子邮件自动化的 Outlook 安全警告 - VBA

How to avoid the Outlook Security warning for email automation - VBA

提问by Paolo Bernasconi

I'm trying to send an email from Excel 2010 in VBA, through Outlook 2010. Most other answers on SO don't seem to have any method of using VBA to do this, nor for Outlook/Excel 2010.

我正在尝试通过 Outlook 2010 从 VBA 中的 Excel 2010 发送电子邮件。 SO 上的大多数其他答案似乎没有任何使用 VBA 来执行此操作的方法，也没有用于 Outlook/Excel 2010。

Do any free methods exist? The Redemptionmethod won't be a viable option, unless it is easy to install on 10 machines inside of a large company.

有免费的方法吗？该赎回方法将不会是一个可行的选择，除非它很容易在10台机器上安装一个大公司里面。

This is how I currently send emails:

这是我目前发送电子邮件的方式：

Dim emailAddr As String
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
 .To = "[email protected]"
 .Subject = "Demande"
 .HtmlBody = CombinedValueHtml
 .Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

Thanks for all your help in advance.

提前感谢您的所有帮助。

回答by Tony Dallimore

This is a partial answer. I have made it a Community Wiki answer in the expectation that someone else can explain the final part which I cannot get to work.

这是部分答案。我已将其作为社区 Wiki 答案，希望其他人可以解释我无法开始工作的最后部分。

This web page, http://msdn.microsoft.com/en-us/library/office/aa155754(v=office.10).aspx, explains the first three parts of the process. It was written in 1999 so cannot be followed exactly because it refers to old versions of Windows and Office.

此网页http://msdn.microsoft.com/en-us/library/office/aa155754(v=office.10).aspx解释了该过程的前三个部分。它写于 1999 年，因此不能完全遵循，因为它指的是旧版本的 Windows 和 Office。

The first step is to add Digital Signature for VBA Projectsto your Office installation although I found it under Shared Tools rather than Office Tools. Don't make the mistake of just adding Digital Signature for VBA Projectsto Outlook because, as I discovered, that means you uninstall Word, Excel, etc.

第一步是将VBA 项目的数字签名添加到您的 Office 安装中，尽管我在共享工具而不是 Office 工具下找到了它。不要错误地将VBA 项目的数字签名添加到 Outlook，因为正如我发现的那样，这意味着您要卸载 Word、Excel 等。

The second step is to run Selfcert.exeto create a digital certificate in your own name.

第二步，运行Selfcert.exe，以自己的名义创建数字证书。

The third step is to open Outlook's VBA editor, select Tools then Digital Certificate then Choose to sign the project with your certificate.

第三步是打开 Outlook 的 VBA 编辑器，选择工具，然后选择数字证书，然后选择使用您的证书签署项目。

With these steps you can suppress the warning that Outlook contains macros but this does not suppress that warning that a macro is accessing emails. To suppress that warning, you need a fourth step which is to place your certificate within the Trusted Root Certificate Authorities Store. This web page http://technet.microsoft.com/en-us/library/cc962065.aspxexplains about the Certification Authority Trust Model but I cannot successfully use Microsoft Management Consoleto achieve the fourth step.

通过这些步骤，您可以取消 Outlook 包含宏的警告，但这不会取消宏正在访问电子邮件的警告。要取消该警告，您需要执行第四步，将您的证书放入Trusted Root Certificate Authorities Store 中。此网页http://technet.microsoft.com/en-us/library/cc962065.aspx解释了证书颁发机构信任模型，但我无法成功使用Microsoft 管理控制台来实现第四步。

回答by soccerplayer

Instead .senduse the following:

而是.send使用以下内容：

.Display 'displays outlook email
Application.SendKeys "%s" 'presses send as a send key

note: be careful when using display keys, if you move the mouse and click while the program is running it can change whats going on. also outlook will display on ur screen and send.. if you working on something else's and this bothers you, yea.. not the best idea

注意：使用显示键时要小心，如果在程序运行时移动鼠标并单击它可以改变正在发生的事情。Outlook 也将显示在您的屏幕上并发送..

回答by Dmitry Streblechenko

The Redemption method won't be a viable option, unless it is easy to install on 10 machines inside of a large company.

Redemption 方法不是一个可行的选择，除非它很容易安装在大公司内部的 10 台机器上。

You can use RedemptionLoader- it loads the dll directly and does no require the dll to be installed using the registry.

您可以使用RedemptionLoader- 它直接加载 dll，不需要使用注册表安装 dll。

Also see http://www.outlookcode.com/article.aspx?id=52for all of your options - in short, it is either Extended MAPI in C++ or Delphi, Redemption (wraps Extended MAPI and can be used form any language) or a utility like ClickYes.

另请参阅http://www.outlookcode.com/article.aspx?id=52了解所有选项 - 简而言之，它是 C++ 中的 Extended MAPI 或 Delphi、Redemption（包装了扩展 MAPI，可用于任何语言) 或像 ClickYes 这样的实用程序。

回答by Alexander Remesch

If you don't send the message immediately but just display it and let the user do modifications (if any) and let them press the send button theirselves, this would work:

如果您不立即发送消息而只是显示它并让用户进行修改（如果有的话）并让他们自己按下发送按钮，这将起作用：

i.e. use

即使用

.Display

instead of

代替

.Send

回答by Dani Aya

I explained how you can use vba to send emails in this answerYou will find a macro that I use extensively in my daily work.

我在这个答案中解释了如何使用 vba 发送电子邮件您会发现一个我在日常工作中广泛使用的宏。

Following recomendations from @Floern, here is the explanation:

根据@Floern 的建议，以下是解释：

In order to insert images (signature as images) you could use the following code:

为了插入图像（签名为图像），您可以使用以下代码：

Step 1.Copy this code an paste in class module and name that class module like "MailOptions"

步骤 1.将此代码复制粘贴到类模块中，并将该类模块命名为“MailOptions”

Private Message As CDO.Message
Private Attachment, Expression, Matches, FilenameMatch, i

Public Sub PrepareMessageWithEmbeddedImages(ByVal FromAddress, ByVal ToAddress, ByVal Subject, ByVal HtmlContent)

    Set Expression = CreateObject("VBScript.RegExp")
    Expression.Pattern = "\<EMBEDDEDIMAGE\:(.+?)\>"
    Expression.IgnoreCase = True
    Expression.Global = False 'one match at a time

    Set Message = New CDO.Message
    Message.From = FromAddress
    Message.To = ToAddress
    Message.Subject = Subject

    'Find matches in email body, incrementally increasing the auto-assigned attachment identifiers
    i = 1
    While Expression.Test(HtmlContent)
        FilenameMatch = Expression.Execute(HtmlContent).Item(0).SubMatches(0)
        Set Attachment = Message.AddAttachment(FilenameMatch)
        Attachment.Fields.Item("urn:schemas:mailheader:Content-ID") = "<attachedimage" & i & ">" ' set an ID we can refer to in HTML
        Attachment.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline" ' "hide" the attachment
        Attachment.Fields.Update
        HtmlContent = Expression.Replace(HtmlContent, "cid:attachedimage" & i) ' update the HTML to refer to the actual attachment
        i = i + 1
    Wend

    Message.HTMLBody = HtmlContent
End Sub

Public Sub SendMessageBySMTP(ByVal SmtpServer, ByVal SmtpUsername, ByVal SmtpPassword, ByVal UseSSL)
    Dim Configuration
    Set Configuration = CreateObject("CDO.Configuration")
    Configuration.Load -1 ' CDO Source Defaults
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SmtpServer
    'Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SmtpPort
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30

    If SmtpUsername <> "" Then
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SmtpUsername
        Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SmtpPassword
    End If
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = UseSSL
    Configuration.Fields.Update
    Set Message.Configuration = Configuration
    Message.Send
End Sub

Step 2.In an standar module you will elaborate your .html content and instantiate a object from the class:

第 2 步。在标准模块中，您将详细说明 .html 内容并从类中实例化一个对象：

public sub send_mail()

Dim signature As String
dim mail_sender as new MailOptions 'here you are instantiating an object from the class module created previously
dim content as string

signature = "C:\Users\your_user\Documents\your_signature.png"

content = "<font face=""verdana"" color=""black"">This is some text!</font>"
content = content & "<img src=""<EMBEDDEDIMAGE:" & signature & " >"" />"

mail_sender.PrepareMessageWithEmbeddedImages _
                    FromAddress:="[email protected]", _
                    ToAddress:="[email protected]", _
                    Subject:="your_subject", _
                    HtmlContent:=content

'your_Smtp_Server, for example: RelayServer.Contoso.com
correos.SendMessageBySMTP "your_Smtp_Server", "your_network_user_account", "your_network_user_account_password", False

end sub