使用Gmail发送SMTP邮件时出现‘SendUsing配置无效’错误怎么办？

我尝试实现邮件自动化发送，不希望使用Outlook，因此选择Gmail方案。此前找到的可行VBA自动化邮件方案均为2020年及更早版本，多数依赖已被淘汰的“低安全性应用”设置。我的Gmail账户创建于2025年1月2日，已启用两步验证并生成应用密码，按教程配置后仍无法解决“SendUsing配置无效”的问题。

运行时错误信息 #

-2147220960 (80040220) The "SendUsing" configuration is invalid.

原代码（已勾选引用“Microsoft CDO for Windows 2000”库） #

Option Compare Database
' Global variables
Dim newMail As CDO.Message
Dim newConfiguration As CDO.Configuration
Dim Fields As Variant
Dim msConfigURL As String

' References include Microsoft CDO for Windows 2000 Library

Sub Send_Email()
‘ Create error handler
On Error GoTo errHandle

' Create the new instances of the objects
Set newMail = New CDO.Message
Set newConfiguration = New CDO.Configuration

' Set all the default values
newMail.Configuration.Load -1

' Put in the message info
With newMail
   .Subject = "VBA Test"
   .From = “**********@gmail.com”           ‘ A valid and working Gmail account with email enabled
   .To = “*********@outlook.com”                ‘ An email address that I keep for testing purposes
   .TextBody = "Test message sent using VBA script in Access"

End With

' Set the configuration
msConfigURL = "https://schemas.microsoft.com/cdo/configuration"

' Make the Fields
Set Fields = newConfiguration.Fields

With Fields
   .Item(msConfigURL & "/sendusername") = "**********@gmail.com"
   .Item(msConfigURL & "/sendpassword") = "**************"      ‘ I have tried the account password and the generated App Password
   .Item(msConfigURL & "/smtpusesssl") = True
   .Item(msConfigURL & "/smtpauthenticate") = 1
   .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
   .Item(msConfigURL & "/smtpserverport") = 465
   .Item(msConfigURL & "/sendusing") = 2

   ' Update the configuration
   .Update

End With

' Transfer the configuration
newMail.Configuration = newConfiguration

' Send the email
newMail.Send

MsgBox "Email has been sent", vbInformation

' Exit lines for routine
exit_line:
   ' Release object from memory
   Set newMail = Nothing
   Set newMessage = Nothing

   Exit Sub

' Error handling
errHandle:
Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
   Case Else   'Report other errors
       MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description

End Select

Resume exit_line

End Sub

问题排查与修正方案 #

• 替换中文全角引号：原代码中.From、.To以及部分注释使用了中文全角引号，VBA无法识别，需全部替换为英文半角引号。
• 调整配置加载顺序：原代码先加载了默认配置newMail.Configuration.Load -1，后续赋值自定义配置时会出现冲突。应先完成newConfiguration的所有字段设置，再将其赋值给newMail.Configuration，删除提前加载默认配置的代码。
• 确认应用密码有效性：确保使用的是Gmail针对“其他(自定义名称)”生成的16位无空格应用密码，不要使用账户原密码。
• 添加SMTP连接超时设置：在配置字段中增加超时参数，避免因网络延迟导致配置无效：

  .Item(msConfigURL & "/smtpconnectiontimeout") = 30
  

• 修正对象释放错误：原代码中Set newMessage = Nothing的newMessage未定义，应改为Set newConfiguration = Nothing。

修正后的完整代码 #

Option Compare Database
' Global variables
Dim newMail As CDO.Message
Dim newConfiguration As CDO.Configuration
Dim Fields As Variant
Dim msConfigURL As String

' References include Microsoft CDO for Windows 2000 Library

Sub Send_Email()
' Create error handler
On Error GoTo errHandle

' Create the new instances of the objects
Set newMail = New CDO.Message
Set newConfiguration = New CDO.Configuration

' Set the configuration
msConfigURL = "https://schemas.microsoft.com/cdo/configuration"

' Make the Fields
Set Fields = newConfiguration.Fields

With Fields
   .Item(msConfigURL & "/sendusername") = "your-gmail-account@gmail.com"
   .Item(msConfigURL & "/sendpassword") = "your-16-digit-app-password"
   .Item(msConfigURL & "/smtpusesssl") = True
   .Item(msConfigURL & "/smtpauthenticate") = 1
   .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
   .Item(msConfigURL & "/smtpserverport") = 465
   .Item(msConfigURL & "/sendusing") = 2
   .Item(msConfigURL & "/smtpconnectiontimeout") = 30
   ' Update the configuration
   .Update
End With

' Transfer the configuration to mail object
newMail.Configuration = newConfiguration

' Put in the message info
With newMail
   .Subject = "VBA Test"
   .From = "your-gmail-account@gmail.com"
   .To = "test-account@outlook.com"
   .TextBody = "Test message sent using VBA script in Access"
End With

' Send the email
newMail.Send

MsgBox "Email has been sent", vbInformation

' Exit lines for routine
exit_line:
   ' Release object from memory
   Set newMail = Nothing
   Set newConfiguration = Nothing
   Exit Sub

' Error handling
errHandle:
Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
   Case Else   'Report other errors
       MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select

Resume exit_line

End Sub

内容的提问来源于stack exchange，提问作者Trev Buck