VBA 之调用CDO接口发送邮件

VBA自带的语法可以处理Outlook邮箱,但是缺点是outlook还需要配置,
但是调用系统自带的CDO接口可以用SMTP模式发送各大第三方的邮箱,只需要开启POP3/SMTP模式即可,兼容性更好.

Sub CDOSENDEMAIL()
'On Error Resume Next '出错后继续执行
Application.DisplayAlerts = False '禁用系统提示
'ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly '将工作簿设置为只读模式
Set CDOMail = CreateObject("CDO.Message") '创建对象
CDOMail.From = "sender@sina.com" '设置发信人的邮箱
CDOMail.To = "receiver@qq.com" '设置收信人的邮箱
CDOMail.Subject = "主题:用CDO发送邮件试验" '设定邮件的主题
CDOMail.TextBody = "文本内容"   '使用文本格式发送邮件似乎不能换行,只能切换成HTML模式换行."
CDOMail.HtmlBody = "使用html" & "<br>" & "换行后的内容" '使用Html格式发送邮件
'CDOMail.AddAttachment ThisWorkbook.Path & "\" & "a" & ".xlsx" '发送当前目录下的工作簿a为附件
stUl = "http://schemas.microsoft.com/cdo/configuration/" '微软服务器网址
'stUl = "http://pop.sina.com" '微软服务器网址
With CDOMail.Configuration.Fields
'.Item(stUl & "smtpusessl") = True
.Item(stUl & "smtpserver") = "smtp.sina.com" 'SMTP服务器地址
.Item(stUl & "smtpserverport") = 25 'SMTP服务器端口 465 是ssl连接 25是普通连接
.Item(stUl & "sendusing") = 2 '发送端口
.Item(stUl & "smtpauthenticate") = 1 '远程服务器需要验证
.Item(stUl & "sendusername") = "sxfxtf@sina.com" '发送方邮箱名称
.Item(stUl & "sendpassword") = "授权码" '上面连接生成的授权码，非你qq邮箱密码
.Item(stUl & "smtpconnectiontimeout") = 60 '连接超时（秒）
.Update
End With
CDOMail.Send '执行发送
Set CDOMail = Nothing '发送成功后即时释放对象
'If Err.Number = 0 Then
'MsgBox "成功发送邮件", , "温馨提示" '如果没有出错，则提示发送成功
'Else
'MsgBox Err.Description, vbInformation, "邮件发送失败" '如果出错，则提示错误类型和错误代码
'End If
'ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite '将工作簿设置为读写模式
'Kill ThisWorkbook.Path & "\" & "a" & ".xlsx" '新工作簿删除
'Call dayin
Application.DisplayAlerts = True '恢复系统提示
End Sub