欢迎来到代码驿站!

VBS

当前位置:首页 > 脚本语言 > VBS

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

时间:2022-03-19 10:48:08|栏目:VBS|点击:
'用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

上一篇:VBS下载文件的新方法

栏    目:VBS

下一篇:vbscript实现的根据不同时间段显示不同的欢迎语

本文标题:vbs定时发送邮件的方法与代码

本文地址:http://www.codeinn.net/misctech/196623.html

推荐教程

广告投放 | 联系我们 | 版权申明

重要申明:本站所有的文章、图片、评论等,均由网友发表或上传并维护或收集自网络,属个人行为,与本站立场无关。

如果侵犯了您的权利,请与我们联系,我们将在24小时内进行处理、任何非本站因素导致的法律后果,本站均不负任何责任。

联系QQ:914707363 | 邮箱:codeinn#126.com(#换成@)

Copyright © 2020 代码驿站 版权所有