作者:张茂彪6 | 来源:互联网 | 2023-09-23 17:50
'如需要在发信邮箱的发件箱中保留发送的邮件,需要在邮件服务器设置SMTP发信后保存DimFile,Path,FilePath,ReturnValueFileXXX.XX
'如需要在发信邮箱的发件箱中保留发送的邮件,需要在邮件服务器设置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