使用vbs脚本通过SMTP服务批量发送邮件

'从数据库用户表中取出邮件信息循环发送
set cndb=CreateObject("ADODB.Connection")
cndb.open "Provider=SQLOLEDB.1;Password=[密码];Persist Security Info=True;User ID=[数据库用户名];Initial Catalog=test;Data Source=[数据库]"
on error resume next
sql="select * from [数据表]"
set rs=createobject("adodb.recordset")
rs.open sql,cndb,1,1
servername=""
do until rs.eof
Wscript.Echo trim(rs.Fields("mailbox"))
sendmail "发送人邮箱",trim(rs.Fields("mailbox")),"关于停止使用旧邮件系统的通知","",txt
rs.movenext
loop
msgbox "ok"
function sendmail(mailfrom,mailto,mailsubject,mailcc,mailtext)
ON ERROR RESUME NEXT
sendmail=0
Dim msg
Dim iConf
Dim Flds
set msg =CreateObject ("cdo.message")
set iconf =CreateObject ("cdo.configuration")
set Flds = iConf.Fields
ExpiredTime = 172800
' Set the configuration for Network Send
with flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'可用的SMTP服务器[测试开通] telnet inner.chinaXXX.com 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "inner.chinaXXX.com"
.Item("cdoSMTPServerPort") = 25
.Item("cdoSMTPConnectionTimeout") = 30
.Item("cdoSMTPAccountName") = mailfrom
.Item("cdoSendUserReplyEmailAddress") = mailfrom
.Item("cdoSendEmailAddress") = mailfrom
.Update
end with
Set msg.Configuration = iConf
With msg
.From = mailfrom
.To = mailto
.CC = mailcc
.Subject = mailsubject
'.TextBody = mailtext
.CreateMHTMLBody "http://localhost/SendMail.htm", cdoSuppressNone
'添加附件
.AddAttachment "d:\zn\手册.doc"
'.BodyFormat = 0
.Send
End With
if err.number<>0 then
Wscript.Echo "False--" & trim(rs.Fields("mailbox"))
err.number=0
end if
set iConf = nothing
Set msg = Nothing
set flds = nothing
end function