'用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
【vbs定时发送邮件的方法与代码】相关文章：