vbs定时发送邮件的方法与代码

作者佚名来源 ASP编程浏览发布时间 2013-07-09

''用VBS写个脚本,然后用WINDOWS平台下的计划任务来调用,每天定时群发邮件.
''代码如下:下载地址http://www.51tiao.com/info.vbs

复制代码代码如下:

Dimconnstr,conn
Dimsql,rs,msg

SubOpenDB()
ConnStr="DSN=51tiao.Com;UID=sa;PWD=;"
IfNotIsObject(Conn)Then
Setconn=CreateObject("Adodb.Connection")
Conn.OpenConnStr
EndIf
EndSub

OpenDB()
Send()
CloseDB()

SubSend()
OnErrorResumeNext''有错继续执行
''邮件内容
msg="<html><head><title>上海跳蚤市场今日推荐"&Date()&"</title>"&VBCRLF_
&"<METANAME=""Author""CONTENT=""清风,QQ:110125707,MSN:anwellsz@msn.com"">"&VBCRLF_
&"<styletype=''text/css''>"&VBCRLF_
&""&VBCRLF_
&"</style>"&VBCRLF_
&"</head><body>"&VBCRLF_
&"<tablewidth=640>"&VBCRLF_
&"<tr><tdalign=right>今日推荐信息"&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日<ahref=""http://www.51tiao.com""target=""_blank""><FONTsize=3><b>上海跳蚤市场</b></font></a></td></tr></table></div></td></tr></table>"&VBCRLF_
&"<tablewidth=640>"&VBCRLF_
&"<trbgColor=''#FF9D5C''><tdheight=3></td></tr><tr><td></td></tr><tr>"&VBCRLF_
&"<td>"&VBCRLF_
&"<ul>"&VBCRLF_
&"<p>"
sql="selectdistincttop100a.infoid,a.Strtitlefromnewinfoarticlea"_
&"innerjoinNewinfopropb"_
&"ona.infoid=b.infoidanda.intgood=1anda.intshenhe=1andb.rid1=908anddatediff(d,createtime,getdate())=0"_
&"orderbya.infoiddesc"
Setrs=conn.execute(sql)
Ifrs.eofThen
Wscript.Echo"没有记录!"
rs.close:Setrs=Nothing
ExitSub
EndIf
DoWhileNotrs.eof
msg=msg&"★　<ahref=""http://www.51tiao.com/4/Show.asp?ID="&rs("infoid")&"""title="""&rs("strtitle")&"""target=""_blank"">"_
&rs("Strtitle")&"</a><br>"&VBCRLF
Rs.MoveNext
Loop
Rs.close:setRs=Nothing
msg=msg&"</ul></p>"&VBCRLF_
&"</td>"&VBCRLF_
&"</tr><tr><td></td></tr><trbgColor=''#FF9D5C''><tdheight=3></td></tr>"&VBCRLF_
&"<tralign=right><td><ahref=""http://www.51tiao.com""target=""_blank""><FONTface=''ArialBlack''size=3>51Tiao.Com</FONT></a></td></tr>"&VBCRLF_
&"</table><p></p></body></html>"

''取得邮件地址
Dimi,total,jmail
i=1
DimBadMail''不接收的邮件列表格式''邮件地址'',''邮件地址''
BadMail="''123@163.com'',''122@126.com''"
sql="Selectdistinctb.stremailFromuserinfoainnerjoinuserinfo_1b"_
&"ona.id=b.intuseridandb.stremail<>''''and(charindex(''3'',a.StruserLevel)>0orcharindex(''4'',a.StruserLevel)>0)"_
&"andb.stremailnotin("&BadMail&")"_
&"orderbyb.stremail"
Setrs=CreateObject("Adodb.Recordset")
rs.opensql,conn,1,1
total=rs.recordcount
Ifrs.eofThen
Wscript.Echo"没有用户!"
rs.close:Setrs=Nothing
ExitSub
EndIf

''每二十个邮件地址发送一次
Fori=1Tototal
IfiMod20=1Then
Setjmail=CreateObject("JMAIL.Message")''建立发送邮件的对象
''jmail.silent=true''屏蔽例外错误，返回FALSE跟TRUE两值
jmail.Logging=True''记录日志
jmail.Charset="GB2312"''邮件的文字编码
jmail.ContentType="text/html"''邮件的格式为HTML格式或纯文本
EndIf
jmail.AddRecipientrs(0)
IfiMod20=0Ori=665Then
jmail.From="infoAt51tiao"''发件人的E-MAIL地址
jmail.FromName="上海跳蚤市场"''发件人的名称
jmail.MailServerUserName="info"''登录邮件服务器的用户名(您的邮件地址)
jmail.MailServerPassword="123123"''登录邮件服务器的密码(您的邮件密码)
jmail.Subject="上海跳蚤市场今日推荐"&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日"''邮件的标题
jmail.Body=msg''邮件的内容
jmail.Priority=3''邮件的紧急程序，1为最快，5为最慢，3为默认值
jmail.Send("mail.51tiao.com")''执行邮件发送（通过邮件服务器地址）
jmail.Close()
setjmail=Nothing
EndIf
rs.movenext
Next
rs.close:Setrs=Nothing

''记录日志在C:\jmail年月日.txt
ConstDEF_FSOString="Scripting.FileSystemObject"
Dimfso,txt
Setfso=CreateObject(DEF_FSOString)
Settxt=fso.CreateTextFile("C:\jmail"&DateValue(Date())&".txt",true)
txt.Write"邮件发送成功,共发送了"&total&"封邮件,发送于"&Now()&"<Br><Br>"
txt.Writejmail.log
Settxt=Nothing
Setfso=Nothing
Wscript.Echo"邮件发送成功,共发送了"&total&"封邮件,发送于"&Now()
EndSub

SubCloseDB()
IfIsObject(conn)Then
Conn.close:SetConn=Nothing
EndIf
EndSub

凌众科技专业提供服务器租用、服务器托管、企业邮局、虚拟主机等服务，公司网站：http://www.lingzhong.cn 为了给广大客户了解更多的技术信息，本技术文章收集来源于网络,凌众科技尊重文章作者的版权，如果有涉及你的版权有必要删除你的文章，请和我们联系。以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!

分享到：更多

你可能对下面的文章感兴趣

上一篇: VBS教程：在 VBScript 中使用对象下一篇: 提供个可以显示农历的VBS代码

关于vbs定时发送邮件的方法与代码的所有评论

随机推荐