Option Explicit
Sub SendMail( Optional ByVal sSubject As String , Optional ByVal sBody As String , Optional ByVal sFileName As String )
Dim Jmail
Set Jmail = CreateObject( "jmail.Message " )
If sFileName < > " " Then Jmail.AddAttachment sFileName '附件
Jmail.Charset = "gb2312 "
Jmail.Silent = False
Jmail.Priority = 1 '邮件状态,1-5 1为最高
Jmail.MailServerUserName = "2688i " 'Email帐号
Jmail.MailServerPassWord = "******* " 'Email密码
Jmail.FromName = "邮件 " '发信人姓名
Jmail.From = "[email protected] " '发邮件地址地址
Jmail.Subject = sSubject '主题
Jmail.AddRecipient "[email protected] " '收信人地址
Jmail.Body = sBody '信件正文
Jmail.Send ( "smtp.163.com " ) 'SMTP服务器，如smtp.sohu.com
Set Jmail = Nothing
End Sub
Sub Command1_Click()
SendMail "测试 " , "我爱你 " , "这里填附件地址 "
MsgBox "OK "
End Sub
（1）Body（信件正文） : 字符串
如：JMail.Body = "这里可以是用户填写的表单内容，可以取自From。"
（2）Charset（字符集，缺省为"US-ASCII"） : 字符串
如：JMail.Charset = "US-ASCII"
（3）ContentTransferEncoding : 字符串
指定内容传送时的编码方式，缺省是"Quoted-Printable"
如：JMail.ContentTransferEncoding = "base64"
（4）ContentType（信件的contentype. 缺省是"text/plain"） : 字符串
如果你以HTML格式发送邮件, 改为"text/html"即可。
如：JMail.ContentType = "text/html"
（5）Encoding : 字符串
设置附件编码方式（缺省是"base64）。 可以选择使用的是"base64", "uuencode" or "quoted-printable"
如：JMail.Encoding = "base64"
（6）Log（Jmail创建的日志，前提loging属性设置为true，见下面） : 字符串
如：使用Response.Write( JMail.Log )语句列出日志信息。
（7）Logging（是否使用日志） : 布尔型
如：JMail.Logging = true
（8）Recipients : 字符串
只读属性，返回所有收件人
如：Response.Write( "" + JMail.Recipients + "" );
（9）ReplyTo（指定别的回信地址） : 字符串
如：JMail.ReplyTo = "[email protected]"
（10）Sender（ 发件人的邮件地址） : 字符串
如：JMail.Sender = "[email protected]"
（11）SenderName（发件人的姓名） : 字符串
如：JMail.SenderName = "一克"
（12）ServerAddress（邮件服务器的地址） : 字符串
你可以指定多个服务器，用分号点开。可以指定端口号。
如果serverAddress保持空白，JMail会尝试远程邮件服务器，然后直接发送到服务器上去。
如：JMail.ServerAddress = "mail.263.net.cn"
（13）Subject（设定邮件的标题，可以取自From。）：字符串
如：JMail.Subject = "客户反馈表单"
（14）添加文件附件到邮件
如：JMail.AddAttachment( "c:anyfile.zip" )
（15）AddCustomAttachment( FileName, Data )
添加自定义附件.
如：JMail.AddCustomAttachment( "anyfile.txt", "Contents of file" );
（16）AddHeader( Header, Value )
添加用户定义的信件标头。
如：JMail.AddHeader( "Originating-IP","192.168.10.10" );
（17）AddRecipient（收件人）：字符串
如：JMail.AddRecipient( "[email protected]" );
（18）AddRecipientBCC( Email )，密件收件人：
如：JMail.AddRecipientBCC( "[email protected]" );
（19）AddRecipientCC( Email ) ，抄送收件人：
如：JMail.AddRecipientCC( "[email protected]" )
（20）AddURLAttachment( URL, 文档名)
下载并添加一个来自url的附件. 第二个参数"文档名", 用来指定信件收到后的文件名。
如：JMail.AddURLAttachment( "http://java2000.wol.com.cn/perl/files/jmail.zip", "jmail" )
（21）AppendBodyFromFile( 文件名) ，将文件作为信件正文：
如：JMail.AppendBodyFromFile( "c:anyfile.txt" )
（22）AppendText( Text )
追加信件的正文内容，比如增加问候语或者其它信息。
如：JMail.AppendText( "欢迎访问本站！" )
（23）Close() ，强制JMail关闭缓冲的与邮件服务器的连接：
如：JMail.Close()
（24）Execute() ，执行邮件的发送
如：JMail.Execute()
Private Sub SendMail()
Dim jmail As New SMTPMail
Dim Conn As New ADODB.Connection
Dim Rst As New ADODB.Recordset, Rst1 As New ADODB.Recordset
Dim strRec As String , strRecCC As String
'On Error GoTo Err:
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Password=dir941421;User ID=kiss;Data Source=" & App.Path & "\OAData\OAData.mdb;Persist Security Info=True;Jet OLEDB:System database=" & App.Path & "\OAData\Secured.mdw"
'检测是否有要发送的信件
Rst.CursorLocation = adUseClient
Rst.Open "Select * From ztblMailBox Where BoxNum = 2" , Conn, adOpenDynamic, adLockOptimistic, adCmdText
Do While Not Rst.EOF
'有要发送的信件
'先改变状态为已经发送失败，等发送成功后改变为成功
Conn.Execute "Update ztblMailBox Set BoxNum=3,SendState=False Where Id=" & Rst!id
'开始发送邮件Rst.CursorLocation = adUseClient
Rst1.Open "Select * From ztblMailConfig Where UserCode='" & Rst!UserCode & "'" , Conn, adOpenDynamic, adLockOptimistic, adCmdText
If Rst1.EOF = False Then '有信箱存在
jmail.Sender = Rst1!MailName '取出发送者信箱名称
jmail.ServerAddress = Rst1!SmtpServer '服务器地址
jmail.ServerPort = "25"
jmail.SenderName = Rst1!Sender '取出发信人的姓名:汉字的也可以
jmail.Message.From = Rst1!MailName '来之何方
jmail.Message.FromName = Rst1!Sender '取出发信人的姓名:汉字的也可以
jmail.Message.Subject = Rst!Topic '标题
jmail.Message.Body = Rst!Content '内容
jmail.ClearAttachments '清除原来的附件
If FolderManager.FolderExists(Rst!Accessory) Then '判断文件夹是否存在
Set cFolder = FolderManager.GetFolder(Rst!Accessory)
Set cFile = cFolder.Files '建立文件集合
For Each FileInfo In cFile
jmail.Message.AddAttachment Rst!Accessory & "\" & FileInfo.Name
Next
End If
jmail.ClearRecipients '清除原来的地址
If Not IsNull(Rst!SendTo) Then
strRecCC = Rst!SendTo
If InStr( 1 , strRecCC, ";" , vbTextCompare) <> 0 Then
strRec = Left(strRecCC, InStr( 1 , strRecCC, ";" , vbTextCompare) - 1 )
strRecCC = Mid(strRecCC, InStr( 1 , strRecCC, ";" , vbTextCompare) + 1 )
If InStr( 1 , strRecCC, "@" , vbTextCompare) <> 0 Then
strRecCC = Replace(strRecCC, ";" , "" , 1 , - 1 , vbTextCompare)
End If
End If
End If
jmail.Message.AddRecipient strRec
If strRecCC <> "" Then jmail.Message.AddRecipientCC strRecCC
jmail.Message.MailServerUserName = Left$(Rst1!MailName, InStr( 1 , Rst1!MailName, "@" ) - 1 ) '服务器的用户名称
jmail.Message.MailServerPassWord = Rst1!MailPass '密码验证
jmail.ContentTransferEncoding = "base64"
jmail.Encoding = "base64"
jmail.Message.Charset = "gb2312"
jmail.Message.Silent = True
jmail.Message.ContentType = "multipart/html" '文本还是网页
jmail.Logging = False '是否记录日志
If jmail.Message.Send(Rst1!SmtpServer) Then
Conn.Execute "Update ztblMailBox Set SendState=True Where Id=" & Rst!id
End If
End If
Rst1.Close
Rst.MoveNext
DoEvents
Loop
Err:
Rst.Close
jmail.Close
Set jmail = Nothing '彻底释放Jmail
Unload Me
End Sub