使用 Access VBA 发送电子邮件答案

【问题标题】：Sending Email using Access VBA使用 Access VBA 发送电子邮件
【发布时间】：2021-02-14 02:40:36
【问题描述】：

我正在尝试通过 Access 发送电子邮件。电子邮件不会自动发送。我必须在弹出的电子邮件中点击发送。

我的代码中是否缺少阻止电子邮件发送的内容。

Dim strTo As String
Dim strMessage As String
Dim strSubject As String

strTo = "Hazat.Bangurah@umm.edu"

strSubject = "New Lab Charge Codes"
strMessage = "Attached are the New Lab Charge Codes"

DoCmd.SendObject acSendQuery, "std qry_Master to HPM Lab Standard Compare", acFormatXLSX, strTo, , , strSubject, strMessage

【问题讨论】：

什么弹出窗口？是来自电子邮件客户端还是来自 MS-Access 的弹出窗口？
看这个：docs.microsoft.com/en-us/office/vba/api/access.docmd.sendobject 似乎你需要使用EditMessage := False 来避免先编辑它。始终先阅读文档。
弹出窗口来自电子邮件客户端 Outlook，其中电子邮件是使用附件创建的，我必须添加发送。

标签： vba email ms-access

【解决方案1】：

即使您使用EditMessage := False，DoCmd.SendObject 也会从 Outlook 弹出警告。因此，您可以应用解决方法来避免它。首先将查询保存到您的磁盘并将该文件添加为附件。可以通过编程方式完成这项工作。尝试使用以下代码发送邮件而不弹出任何警告，但您必须将 Programmatic Access 设置为 Never warn me about suspicious activity。请参阅Microsoft Answer.的这篇帖子

Private Sub CmdSendMail_Click()
Dim strTo As String
Dim strMessage As String
Dim strSubject As String
Dim attch As String

strTo = "Hazat.Bangurah@umm.edu"
attch = "D:\MyFile.xlsx"
strSubject = "New Lab Charge Codes"
strMessage = "Attached are the New Lab Charge Codes"

    ' Save file to disk.
    DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, attch, False, , , acExportQualityPrint

    Call SendEmailWithOutlook(strTo, strSubject, strMessage, attch)
End Sub

'======= Function to send email =======
Public Function SendEmailWithOutlook( _
    MessageTo As String, _
    Subject As String, _
    MessageBody As String, strAttachment As String)

    ' Define app variable and get Outlook using the "New" keyword
    Dim OutApp As Object
    Dim OutMail As Object  ' An Outlook Mail item
 
    ' Create a new email object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)


    ' Add the To/Subject/Body to the message and display the message
    With OutMail
        .To = MessageTo
        .Attachments.Add strAttachment
        .Subject = Subject
        .Body = MessageBody
        .Send       ' Send the message immediately
    End With

    ' Release all object variables
    Set OutApp = Nothing
    Set OutMail = Nothing

End Function

要设置程序访问，您必须以管理员身份打开 Outlook。然后按照下面的截图。

【讨论】：