当前位置: 首页 > 图文教程 > 脚本技术 > VBScript > vbs定时发送邮件的方法与代码

VBScript
用vbs检索在运行对话框中键入的一系列命令的代码
编写可以打开文本文件并打乱在该文件中所找到的单词顺序的vbs脚本
在 HTA 中暂停脚本的方法
运行脚本之前,如何确定计算机上的默认脚本宿主的代码
用vbs实现删除名称中有撇号的文件夹
用vbs将输出内容写到屏幕以覆盖当前屏幕上的内容的方法
用vbs实现配置无人登录计算机时使用的屏幕保护程序
用vbs更改 Internet Explorer 的标题栏
用vbs读取文本文件的最后一行
用vbs实现重新启动 Internet Explorer
用vbs实现禁用服务
用vbs确定计算机是否有 USB 2.0 端口的代码
用vbs列出注册表中 Run 项中的所有项目
用vbs将名称截断以使其最多包含 16 个字符的代码
用vbs将本地文件替换为在文件服务器上找到的新版本
用vbs确定脚本正在哪一个帐户下运行
用vbs确定可移动驱动器的连接时间
用vbs记录屏幕保护程序的开始时间和结束时间
用vbs计算某个词在日志文件中的出现次数
vbs病毒的简单例子源代码解析

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-11   浏览: 72 ::
收藏到网摘: n/a

'用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: [email protected]"">"&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>今日推荐信息 "&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日 <a href=""http://www.51tiao.com"" 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=""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> </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> </td></tr>"&VBCRLF _
&"</table><p></p></body></html>"
'取得邮件地址
Dim i,total,jmail
i = 1
Dim BadMail '不接收的邮件列表 格式 '邮件地址','邮件地址'
BadMail = "'[email protected]','[email protected]'"
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