从 MS Access 发送 SMTP 电子邮件时出错答案

【问题标题】：Error sending SMTP email out of MS Access从 MS Access 发送 SMTP 电子邮件时出错
【发布时间】：2021-12-31 17:07:29
【问题描述】：

我在使用 CDO SMTP 从 MS Access 发送电子邮件时遇到问题。多年来，这一直没有问题，但现在最近出现了 -2147220973 传输无法定期连接到服务器错误 - 也不是每封电子邮件，可能是 30%。我相信这是由于微软在逐步淘汰 TLS 1.0、1.1 方面所做的更改，尽管从我阅读的代码来看，我（以及许多其他人正在使用）实际上并没有考虑到这一点。但无论如何，我找不到任何其他选项来从 MS Access 发送不使用 CDO 和/或始终有效的电子邮件。下面是代码，类似于很多其他人正在使用的代码。还尝试了端口 587 和 465 以及使用和不使用 SendTLS 选项：

Function Mailer(SendTo As String, SendFrom As String, SendBCC As String, Sender As String, Subject As String, Body As String, IsHTML As Boolean, Attach As Boolean, AttPath As String, ReqRec As Boolean, FName As String)

Body = Body & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "THIS MAILBOX IS NOT MONITORED. PLEASE DO NOT REPLY!"

Dim iMsg As New CDO.Message
Dim iBp As CDO.IBodyPart
Dim Configuration
Set Configuration = CreateObject("CDO.Configuration")

Configuration.Load -1 ' CDO Source Defaults
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = DLookup("[SMTPsendusing]", "tblCompanyInfo") '2
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = DLookup("[SMTPServer]", "tblCompanyInfo") ' "smtp.office365.com"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = DLookup("[SMTPServerPort]", "tblCompanyInfo") '25
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = DLookup("[SMTPauthenticate]", "tblCompanyInfo") '1
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = DLookup("[SMTPsendusername]", "tblCompanyInfo") '"email@doamin.co.nz"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("[SMTPsendpassword]", "tblCompanyInfo") '"*********"
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = DLookup("[SMTPuseSSL]", "tblCompanyInfo") 'True
Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendtls") = DLookup("[SMTPSendTLS]", "tblCompanyInfo") 'True
Configuration.Fields.Update

With iMsg
Set .Configuration = Configuration
    .To = SendTo
    .From = SendFrom
    .BCC = SendBCC
    .Sender = Sender
    .Subject = Subject
If IsHTML = True Then
    .HTMLBody = Body
Else
    .TextBody = Body
End If
If ReqRec = True Then
    .MDNRequested = True
End If

If Attach = True Then
    Set iBp = .AddAttachment(AttPath & FName)
    'iBp.ContentMediaType = "text/html"
    iBp.ContentMediaType = "text"
End If

    .Send
    DoEvents
End With

End Function

任何帮助表示赞赏。谢谢

【问题讨论】：

cdo.message 是要使用的正确标签。 [CDO] 用于 Eclipse 建模框架...

标签： vba email ms-access smtp cdo.message

【解决方案1】：

对于用作发件人的邮件帐户，您可能需要设置 MFA：

https://account.activedirectory.windowsazure.com/UserManagement/MultifactorVerification.aspx

然后，对于此帐户，请转到：

https://mysignins.microsoft.com/security-info

并设置应用密码。

然后将该密码用于 CDO。这对我们有用，使用端口 25。

【讨论】：