3

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

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

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

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 = "xxxx@xxxx.edu"
 .Subject = "Demande"
 .HtmlBody = CombinedValueHtml
 .Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

感谢您提前提供的所有帮助。

4

5 回答 5

2

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

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

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

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

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

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

于 2012-08-21T20:43:50.090 回答
1

而是.send使用以下内容：

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

注意：使用显示键时要小心，如果在程序运行时移动鼠标并单击它可以改变正在发生的事情。Outlook 也将显示在您的屏幕上并发送..如果您在做其他事情，这让您感到困扰，是的.. 不是最好的主意

于 2014-08-17T00:06:51.413 回答
0

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

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

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

于 2014-08-17T01:07:29.830 回答
-1

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

即使用

.Display

代替

.Send
于 2017-07-04T11:47:25.947 回答
-2

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

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

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

步骤 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

第 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:="chrism_mail@blablabla.com", _
                    ToAddress:="addressee_mail@blablabla.com", _
                    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
于 2016-03-26T19:29:50.050 回答