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

扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条

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

作者：清风来源：CSDN 2008年3月28日

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

代码如下:

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: _
&"<style type='text/css'>"&VBCRLF _
&""&VBCRLF _
&"</style>"&VBCRLF _
&"</head><body>"&VBCRLF _
&"<table width=640>"&VBCRLF _
&"<tr><td align=right>今日推荐信息  "&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日  <a href="" target=""_blank""><FONT size=3><b>上海跳蚤市场</b></font></a>    </td></tr></table></div></td></tr></table>"&VBCRLF _
&"<table width=640>"&VBCRLF _
&"<tr bgColor='#FF9D5C'><td height=3></td></tr><tr><td> </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=""")&""" 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> </td></tr><tr bgColor='#FF9D5C'><td height=3></td></tr>"&VBCRLF _
&"<tr align=right><td><a href=""target=""_blank""><FONT face='Arial Black' size=3>51Tiao.Com</FONT></a>      </td></tr>"&VBCRLF _
&"</table><p></p></body></html>"

'取得邮件地址
Dim i,total,jmail
i = 1
Dim BadMail '不接收的邮件列表格式 '邮件地址','邮件地址'
BadMail = "
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

VIP专区

VIP用户

普通用户

邮件订阅

如果您非常迫切的想了解IT领域最新产品与技术信息，那么订阅至顶网技术邮件将是您的最佳途径之一。

重磅专题

往期文章

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

业界热点: