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

来源：本站原创|时间：2020-01-10|栏目：vb|点击：次
'用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>今日推荐信息  "&Year(Date())&"年"&Month(Date())&"月"&Day(Date())&"日  <a href=""http://www.51tiao.com"" target=""_blank""><FONT size=3>上海跳蚤市场</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  

    '每二十个邮件地址发送一次  
    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脚本结合echo的dos下实现
栏目：vb
下一篇：利用vbs类实现css按钮的代码
本文标题：vbs定时发送邮件的方法与代码
本文地址：https://www.xiuzhanwang.com/a1/vb/7974.html
更多vb
vb

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

您可能感兴趣的文章

阅读排行

本栏相关

随机阅读
