使用excel CDO发送电子邮件:sendusing配置值无效

时间:2019-07-11 20:33:04

标签: excel vba cdo.message

我按照此链接中的说明使用VBA发送电子邮件:https://www.makeuseof.com/tag/send-emails-excel-vba/

我使用的电子邮件是个人gmail帐户。

起初,我有“无法连接到服务器”错误,但是在gmail上打开安全性较低的应用访问权限后,它似乎可以解决此错误。然后我收到一个新错误,说“ sendusing配置值无效”。正如我在其他许多示例中所看到的那样,我的sendusing值为2,所以我不确定为什么这对我不起作用。请参阅下面的代码:

Sub Email()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String

strSubject = "Results from Excel Spreadsheet"
strFrom = "XXX@gmail.com"
strTo = "XXX@companygmail.com"
strCc = ""
strBcc = ""
strBody = "The shipped sales is: " & Str(Sheet1.Cells(5, 2))

Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1

Set SMTP_Config = CDO_Config.Fields

With SMTP_Config
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "XXX@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXX"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 .Update
End With


CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send

Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

0 个答案:

没有答案