六顶帽发邮件类（使用 VBA 轻松发送电子邮件）
5.00/5 (3投票s)
使用 VBA 和 SendGrid API 从您的 Microsoft 应用程序轻松发送电子邮件
引言
您可能会认为，由于 Microsoft Office 文档、电子表格和报告等文件比其他任何附件都更常通过电子邮件发送，因此使用 Office 自动化发送电子邮件应该是一个轻而易举的事情。不幸的是，情况并非总是如此。为什么？因为从 Office 发送电子邮件的所有当前方法都依赖于 Office 应用程序所处的环境。因此，如果您的应用程序安装在通过 Outlook 发送电子邮件的服务器上，那么您很可能最终会使用 Outlook 自动化等方式发送电子邮件。
从 CDO 到 Outlook 的所有这些方法都依赖于 SMTP。因此，如果您的环境没有设置并配置好 SMTP 或 SMTP 服务器，那么您将无法发送电子邮件。直到现在。去年，我写了一篇关于“轻松地从 Microsoft Access 发送电子邮件”的文章，使用了 SendGrid API。在解决了该方法的一些难题后，它取得了巨大的成功。我决定简化此方法，并使其更易于使用，将其封装在一个名为：“Six Hat Send Mail Class”的类中。现在，只需几行代码，您就可以轻松地发送带有多个附件的电子邮件。有多简单？请看下面的示例。
背景
基于我去年撰写的文章： https://www.linkedin.com/pulse/email-from-microsoft-access-easy-way-anthony-griggs?trk=mp-reader-card
SendGrid API V2： https://sendgrid.com/docs/API_Reference/Web_API/mail.html
使用 Six Hat 发送类
1. 要开始使用该类，您必须首先下载附加到本文的类文件。
2. 在您的代码中实例化该类。示例
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
注意：除了声明类之外，我还声明了一个用于附件的字符串变量，以及一个用于直接从 SendGrid API 返回电子邮件状态的变量。
3. 接下来，为了使示例保持简单，我将硬编码文件路径到附件变量中。关于添加附件的一些要点
- 附件是一个集合，您可以添加任意多个。
- 每个附件的大小不能超过 7MB。（根据 SendGrid API 的限制）
- 要添加附件，只需插入包含文件名的完整文件路径。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
4. 接下来，我将向实例化的类添加一个 With 块。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
End With
5. 在 With 块内，我们将提供第一个参数：[EmailTo]。重要的是要注意 [EmailTo] 是一个集合。您可以提供任意多个 [EmailTo]。[EmailTo] 参数接受两个参数。1. (必需)：EmailTo 和 2. (可选) EmailToName（您发送电子邮件的收件人的姓名）。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
.EmailTo Nz(Me.txtTo, ""), Nz(Me.txtToName, "")
由于 [EmailTo] 是一个集合，您可以将此电子邮件发送给多人，只需将 [EmailTo] 包装在适合您情况的循环中即可。这是一个发送给所有联系人的完整示例
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Dim rs As DAO.RecordSet
Set rs = CurrentDb.OpenRecordset("Select * FROM tblContacts")
Set SHSM = New SixHatSendMail
If Not (rs.EOF And rs.BOF) Then
DoWhile Not rs.EOF
With SHSM
.EmailTo Nz(rs.Fields("Email"), ""), Nz(rs.Fields("ContactName"), "")
' Email Body is For Sending HTML Set Argument to True If RTF (Rich Text Format)
.EmailBody Nz(Me.txtBody, ""), True
' Set Class Properties
.EmailFrom = Nz(Me.txtFrom, "")
.EmailReplyTo = Nz(Me.txtReplyTo, "")
.EmailSubject = Nz(Me.txtSubject, "")
.EmailText = Nz(Me.txtText, "")
For Each attachment in Attachments
' Add Attachment(Must Be Full Path To File Including File Name)
.EmailAttachment = attachment
Next
' Send Email
.SendEmail
' Return Email Status
eStatus = .EmailStatus
rs.MoveNext
Wend
MsgBox "Email has been sent with a returned status of: " & eStatus
End If
End With
注意：在上面的示例中，我实际上并没有将多个电子邮件地址发送到 [EmailTo] 集合，我实际上是向我的联系人列表中的每个人发送一封单独的电子邮件。我本可以向 [EmailTo] 集合添加多个电子邮件地址并发送一封电子邮件……我通常选择不使用这种方法的原因是它会在标头中添加大量电子邮件地址……任何收到类似电子邮件地址的人都会看到您的所有联系人。因此，我通常会避免这种方法，尽管它的性能更好。
但是，在上面的示例中，我们已经提供了一个使用此类向集合添加多个值的绝佳示例（包含附件）。
为了尽可能简单，我在我们的主要示例中不使用任何循环。所以，让我们回到我们的主要示例。
6. 接下来我们将提供以下参数：EmailFrom、EmailReplyTo、EmailSubject 和 EmailText。请注意，这些是单值参数，因此它们的提供方式与 EmailTo 不同。
注意：此类中唯一必需的参数是：EmailTo、EmailFrom **以及（EmailText 或 EmailBody）所有其他参数都是可选的**。然而，需要知道的一个陷阱是，类的任何参数都不能接受 Null。但是它们可以接受空字符串。因此，您会注意到我用 Nz() 函数包装了所有值。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
.EmailTo Nz(Me.txtTo, ""), Nz(Me.txtToName, "")
.EmailFrom = Nz(Me.txtFrom, "")
.EmailReplyTo = Nz(Me.txtReplyTo, "")
.EmailSubject = Nz(Me.txtSubject, "")
.EmailText = Nz(Me.txtText, "")
EmailText 或 EmailBody？
如果您发送的是纯文本消息，并且不关心格式和换行符的位置，那么 EmailText 就足够了。但是，如果您关心格式，那么您很可能希望使用 EmailBody 指定格式，它接受 HTML，以便您可以按照您想要的方式格式化您的文档。
考虑到 Microsoft Access（以及 Office 套件的其他成员），我添加了一个富文本格式（RTF）到 HTML 转换器。因此，您可以按照您想要的方式格式化您的 RTF 源，然后像这样将 RTF 设置为 HTML 选项值：
' Email Body is For Sending HTML Set Argument to True If RTF (Rich Text Format)
.EmailBody Nz(Me.txtBody, ""), True
如上在 Microsoft Access 中所示。我使用的是一个文本框，其文本格式属性设置为“Rich Text”。这样我就可以保留应用的格式。如果您查看上面的代码片段，我已将 EmailBody 值设置为 RTF 文本框的名称，然后将 IsRTF 选项设置为 True。将 RTF 选项设置为 true 会将富文本格式转换为 HTML。
7. 电子邮件附件。EmailAttachment 参数接受包含文件名的完整文件路径。我已经在上面提供了添加多个附件的示例。但在我们的主要示例中，我们将保持简单，并使用我们之前添加到 eAttachment 变量中的硬编码文件路径。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
.EmailTo Nz(Me.txtTo, ""), Nz(Me.txtToName, "")
.EmailFrom = Nz(Me.txtFrom, "")
.EmailReplyTo = Nz(Me.txtReplyTo, "")
.EmailSubject = Nz(Me.txtSubject, "")
.EmailText = Nz(Me.txtText, "")
' Add Attachment(Must Be Full Path To File Including File Name)
.EmailAttachment = eAttachment
8. 发送电子邮件：接下来，我们只需调用 SendEmail 过程即可发送电子邮件：
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
.EmailTo Nz(Me.txtTo, ""), Nz(Me.txtToName, "")
.EmailFrom = Nz(Me.txtFrom, "")
.EmailReplyTo = Nz(Me.txtReplyTo, "")
.EmailSubject = Nz(Me.txtSubject, "")
.EmailText = Nz(Me.txtText, "")
' Add Attachment(Must Be Full Path To File Including File Name)
.EmailAttachment = eAttachment
' Send Email
.SendEmail
9. 获取电子邮件状态。发送电子邮件后，您可以返回电子邮件成功状态。为此，我将使用我们最初声明的 eStatus 变量来捕获该值。最后，我喜欢添加一个消息框或某种反馈，表明电子邮件已成功发送。由于在此主要示例中我只发送一封电子邮件，因此我在消息中添加了状态。请参阅下面的完整示例。
Private Sub SendEmail()
Dim SHSM As SixHatSendMail
Dim eAttachment As String
Dim eStatus As String
Set SHSM = New SixHatSendMail
eAttachment = "C:\Users\sixHat\Desktop\Email Header.txt"
With SHSM
.EmailTo Nz(Me.txtTo, ""), Nz(Me.txtToName, "")
.EmailFrom = Nz(Me.txtFrom, "")
.EmailReplyTo = Nz(Me.txtReplyTo, "")
.EmailSubject = Nz(Me.txtSubject, "")
.EmailText = Nz(Me.txtText, "")
' Add Attachment(Must Be Full Path To File Including File Name)
.EmailAttachment = eAttachment
' Send Email
.SendEmail
' Return Email Status
eStatus = .EmailStatus
MsgBox "Email has been sent with a returned status of: " & eStatus
End With
End Sub
设置 SendGrid 凭据
您可以在每次调用时设置您的 SendGrid 凭据，例如：
With SHSM
.SendGridUser = "Your_SendGrid_UserName"
.SendGridPassword = "Your_SendGrid_Password
End With
或者，如果您查看类顶部，您可以全局设置这些凭据：
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@ SET SEND GRID DEFAULT CREDENTIALS
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@ SET SEND GRID DEFAULT CREDENTIALS
Private Const SEND_GRID_USER = "Your_SendGrid_UserName"
Private Const SEND_GRID_PASS = "Your_SendGrid_Password"
Private Const SEND_GRID_KEY = ""
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@ SET SEND GRID DEFAULT CREDENTIALS
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@ SET SEND GRID DEFAULT CREDENTIALS
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|