'如需要在发信邮箱的发件箱中保留发送的邮件，需要在邮件服务器设置SMTP发信后保存
Dim File, Path, FilePath, ReturnValue
File = "XXX.XXX" '文件名
Path = Wscript.CreateObject("Wscript.Shell").SpecialFolders("Desktop") '获取桌面路径
If CreateObject("Scripting.FileSystemObject").fileExists(Path & "\" & File) Then
FilePath = Path & "\" & File '完整文件路径
Else
MsgBox "指定文件错误，请检查后重新执行！", , "提示"
Wscript.Quit
End If

Const EmailFrom = "XXX@XXX.com"
Const Password = "XXX"
Const EmailTo = "XXX@XX.com"
Const schema = "http://schemas.microsoft.com/cdo/configuration/"

Set CDO = CreateObject("CDO.Message")
CDO.From = EmailFrom '发件地址
CDO.To = EmailTo '收件地址，多人英文逗号或英文分号分割 抄送用CDO.cc配置，密送用CDO.bcc配置
CDO.Subject = "XXX" '标题
CDO.TextBody = "XXX" '正文
CDO.AddAttachment FilePath '多个附件需重复使用该语句

With CDO.Configuration.Fields
.Item(schema & "sendusing") = 2 '1表示本地SMTP服务器，2表示远程SMTP服务器
.Item(schema & "smtpserver") = "smtp.XXX.com" 'SMTP服务器地址
.Item(schema & "smtpauthenticate") = 1 '身份验证选项，0不使用NTLM，1先尝试NTLM，失败再使用用户名密码，2只使用NTLM
.Item(schema & "sendusername") = EmailFrom
.Item(schema & "sendpassword") = Password '密码或授权码，部分邮箱可能强制要求授权码
.Item(schema & "smtpserverport") = 465 'SMTP服务器端口号
.Item(schema & "smtpusessl") = True '是否使用SSL加密，相应的服务器地址和端口号都要配合调整
.Item(schema & "smtpconnectiontimeout") = 60
.Update
End With

CDO.Send

ReturnValue = MsgBox("邮件已发送，请至邮箱验证！" & vbCrLf & "是否删除附件？", vbYesNo, "提示")

If ReturnValue = vbYes Then
CreateObject("Scripting.FileSystemObject").DeleteFile (FilePath)
End If

Wscript.Quit