vbs定時發(fā)送郵件的方法與代碼
更新時間:2007年03月05日 00:00:00 作者:
'用VBS寫個腳本,然后用WINDOWS平臺下的計(jì)劃任務(wù)來調(diào)用,每天定時群發(fā)郵件.
'代碼如下: 下載地址 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 '有錯繼續(xù)執(zhí)行
'郵件內(nèi)容
msg = "<html><head><title>上海跳蚤市場今日推薦 "&Date()&"</title>"&VBCRLF _
&"<META NAME=""Author"" CONTENT=""清風(fēng), 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>今日推薦信息 "&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 = "'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
'每二十個郵件地址發(fā)送一次
For i = 1 To total
If i Mod 20 = 1 Then
Set jmail = CreateObject("JMAIL.Message") '建立發(fā)送郵件的對象
'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" '發(fā)件人的E-MAIL地址
jmail.FromName = "上海跳蚤市場" '發(fā)件人的名稱
jmail.MailServerUserName = "info" '登錄郵件服務(wù)器的用戶名 (您的郵件地址)
jmail.MailServerPassword = "123123" '登錄郵件服務(wù)器的密碼 (您的郵件密碼)
jmail.Subject = "上海跳蚤市場今日推薦 "&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日" '郵件的標(biāo)題
jmail.Body = msg '郵件的內(nèi)容
jmail.Priority = 3 '郵件的緊急程序,1 為最快,5 為最慢, 3 為默認(rèn)值
jmail.Send("mail.51tiao.com") '執(zhí)行郵件發(fā)送(通過郵件服務(wù)器地址)
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 "郵件發(fā)送成功,共發(fā)送了"&total&"封郵件,發(fā)送于 "&Now()&"<Br><Br>"
txt.Write jmail.log
Set txt = Nothing
Set fso = Nothing
Wscript.Echo "郵件發(fā)送成功,共發(fā)送了"&total&"封郵件,發(fā)送于 "&Now()
End Sub
Sub CloseDB()
If IsObject(conn) Then
Conn.close : Set Conn = Nothing
End If
End Sub
'代碼如下: 下載地址 http://www.51tiao.com/info.vbs
復(fù)制代碼 代碼如下:
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 '有錯繼續(xù)執(zhí)行
'郵件內(nèi)容
msg = "<html><head><title>上海跳蚤市場今日推薦 "&Date()&"</title>"&VBCRLF _
&"<META NAME=""Author"" CONTENT=""清風(fēng), 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>今日推薦信息 "&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 = "'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
'每二十個郵件地址發(fā)送一次
For i = 1 To total
If i Mod 20 = 1 Then
Set jmail = CreateObject("JMAIL.Message") '建立發(fā)送郵件的對象
'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" '發(fā)件人的E-MAIL地址
jmail.FromName = "上海跳蚤市場" '發(fā)件人的名稱
jmail.MailServerUserName = "info" '登錄郵件服務(wù)器的用戶名 (您的郵件地址)
jmail.MailServerPassword = "123123" '登錄郵件服務(wù)器的密碼 (您的郵件密碼)
jmail.Subject = "上海跳蚤市場今日推薦 "&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日" '郵件的標(biāo)題
jmail.Body = msg '郵件的內(nèi)容
jmail.Priority = 3 '郵件的緊急程序,1 為最快,5 為最慢, 3 為默認(rèn)值
jmail.Send("mail.51tiao.com") '執(zhí)行郵件發(fā)送(通過郵件服務(wù)器地址)
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 "郵件發(fā)送成功,共發(fā)送了"&total&"封郵件,發(fā)送于 "&Now()&"<Br><Br>"
txt.Write jmail.log
Set txt = Nothing
Set fso = Nothing
Wscript.Echo "郵件發(fā)送成功,共發(fā)送了"&total&"封郵件,發(fā)送于 "&Now()
End Sub
Sub CloseDB()
If IsObject(conn) Then
Conn.close : Set Conn = Nothing
End If
End Sub
相關(guān)文章
使用 Iisext.vbs 刪除 Web 服務(wù)擴(kuò)展文件的方法
這篇文章主要介紹了如何使用 iisext.vbs 從本地或遠(yuǎn)程計(jì)算機(jī)上刪除 Web 服務(wù)擴(kuò)展文件,需要的朋友可以參考下2014-07-07獲取外網(wǎng)IP并發(fā)送到指定郵箱的vbs代碼[已測]
如名稱所見,獲取外網(wǎng)IP并發(fā)送到指定郵箱,這個腳本比較短小,但不如腳本之家提供的au3腳本功能強(qiáng)大,不過每次電腦開機(jī)記錄一下還是不錯的2012-05-05使用vbscript生成36進(jìn)制自動增長序號的實(shí)現(xiàn)代碼
這篇文章主要介紹了使用vbscript生成36進(jìn)制自動增長序號的實(shí)現(xiàn)代碼,本文代碼也可以在ASP中使用,需要的朋友可以參考下2014-08-08用vbs實(shí)現(xiàn)顯示系統(tǒng)調(diào)色板的代碼
用vbs實(shí)現(xiàn)顯示系統(tǒng)調(diào)色板的代碼...2007-10-10用vbs返回 Internet Explorer 的下載控件和 Applet 的列表
用vbs返回 Internet Explorer 的下載控件和 Applet 的列表...2007-04-04Hardware_Info.vbs 獲取硬件信息的VBS代碼
代碼沒有技術(shù)水準(zhǔn),網(wǎng)上搜索有一大堆類似代碼,關(guān)鍵是中文描述方式,支持多個硬盤、顯卡、內(nèi)存、聲卡、網(wǎng)卡,CPU超頻識別,支持cmd調(diào)用2013-01-01MSScriptControl.ScriptControl組件的用法實(shí)例
這篇文章主要介紹了MSScriptControl.ScriptControl組件的用法實(shí)例,需要的朋友可以參考下2014-08-08