分享
 
 
 

Asp下定时发送邮件的思路 (VBS)

王朝asp·作者佚名  2006-12-26
窄屏简体版  字體: |||超大  

用VBS写个脚本,然后用WINDOWS平台下的计划任务来调用,每天定时群发邮件.

代码如下: 下载地址 http://www.51tiao.com/info.vbs

Dim connstr,conn

Dim sql,rs,msg

Sub OpenDB()

ConnStr = "DSN=51tiao.Com;UID=sa;PWD=;"

If Not IsObject(Conn) Then

Set conn = CreateObject("Adodb.Connection")

Conn.Open ConnStr

End If

End Sub

OpenDB()

Send()

CloseDB()

Sub Send()

On Error Resume Next '有错继续执行

'邮件内容

msg = "<html><head><title>上海跳蚤市场今日推荐 "&Date()&"</title>"&VBCRLF _

&"<META NAME=""Author"" CONTENT=""清风, QQ: 110125707, MSN: anwellsz@msn.com"">"&VBCRLF _

&"<style type='text/css'>"&VBCRLF _

&"<!--"&vbcrlf _

&"td,form,select,input,p,table,.font {font-size: 12px;line-height: 20px}"&VBCRLF _

&"a:link { color: #000000; font-size: 12px; text-decoration: none}"&VBCRLF _

&"a:visited { color: #000000; font-size: 12px; text-decoration: none}"&VBCRLF _

&"a:hover { color: #ff7f2c; font-size: 12px; text-decoration: underline}"&VBCRLF _

&"-->"&VBCRLF _

&"</style>"&VBCRLF _

&"</head><body>"&VBCRLF _

&"<table width=640>"&VBCRLF _

&"<tr><td align=right>今日推荐信息&nbsp;&nbsp;"&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日&nbsp; <a href=""http://www.51tiao.com"" target=""_blank""><FONT size=3><b>上海跳蚤市场</b></font></a>&nbsp;&nbsp;&nbsp;&nbsp;</td></tr></table></div></td></tr></table>"&VBCRLF _

&"<table width=640>"&VBCRLF _

&"<tr bgColor='#FF9D5C'><td height=3></td></tr><tr><td>&nbsp;</td></tr><tr>"&VBCRLF _

&"<td>"&VBCRLF _

&" <ul>"&VBCRLF _

&" <p>"

sql = "select distinct top 100 a.infoid,a.Strtitle from newinfoarticle a "_

&"inner join Newinfoprop b "_

&"on a.infoid = b.infoid and a.intgood = 1 and a.intshenhe = 1 and b.rid1 = 908 and datediff(d,createtime,getdate())=0 "_

&"order by a.infoid desc"

Set rs = conn.execute(sql)

If rs.eof Then

Wscript.Echo "没有记录!"

rs.close : Set rs = Nothing

Exit Sub

End If

Do While Not rs.eof

msg = msg&"★<a href=""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 : set Rs=Nothing

msg = msg & "</ul></p>"&VBCRLF _

&"</td>"&VBCRLF _

&"</tr><tr><td>&nbsp;</td></tr><tr bgColor='#FF9D5C'><td height=3></td></tr>"&VBCRLF _

&"<tr align=right><td><a href=""http://www.51tiao.com"" target=""_blank""><FONT face='Arial Black' size=3>51Tiao.Com</FONT></a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </td></tr>"&VBCRLF _

&"</table><p></p></body></html>"

'取得邮件地址

Dim i,total,jmail

i = 1

Dim BadMail '不接收的邮件列表 格式 '邮件地址','邮件地址'

BadMail = "'123@163.com','122@126.com'"

sql = "Select distinct b.stremail From userinfo a inner join userinfo_1 b "_

&"on a.id = b.intuserid and b.stremail <> '' and (charindex('3',a.StruserLevel)>0 or charindex('4',a.StruserLevel)>0) "_

&"and b.stremail not in ("&BadMail&") "_

&"order by b.stremail"

Set rs = CreateObject("Adodb.Recordset")

rs.open sql,conn,1,1

total = rs.recordcount

If rs.eof Then

Wscript.Echo "没有用户!"

rs.close : Set rs = Nothing

Exit Sub

End If

'每二十个邮件地址发送一次

For i = 1 To total

If i Mod 20 = 1 Then

Set jmail = CreateObject("JMAIL.Message") '建立发送邮件的对象

'jmail.silent = true '屏蔽例外错误,返回FALSE跟TRUE两值

jmail.Logging = True '记录日志

jmail.Charset = "GB2312" '邮件的文字编码

jmail.ContentType = "text/html" '邮件的格式为HTML格式或纯文本

End If

jmail.AddRecipient rs(0)

If i Mod 20 = 0 Or i = 665 Then

jmail.From = "info At 51tiao" '发件人的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()

set jmail = Nothing

End If

rs.movenext

Next

rs.close : Set rs = Nothing

'记录日志在C:\jmail年月日.txt

Const DEF_FSOString = "Scripting.FileSystemObject"

Dim fso,txt

Set fso = CreateObject(DEF_FSOString)

Set txt=fso.CreateTextFile("C:\jmail"&DateValue(Date())&".txt",true)

txt.Write "邮件发送成功,共发送了"&total&"封邮件,发送于 "&Now()&"<Br><Br>"

txt.Write jmail.log

Set txt = Nothing

Set fso = Nothing

Wscript.Echo "邮件发送成功,共发送了"&total&"封邮件,发送于 "&Now()

End Sub

Sub CloseDB()

If IsObject(conn) Then

Conn.close : Set Conn = Nothing

End If

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有