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