VB 调用 Jmail 组件发邮件

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 = "2688i@163.com " '发邮件地址地址

Jmail.Subject = sSubject '主题
Jmail.AddRecipient "2688i@163.com " '收信人地址
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 = "anyother@mailhost.com"

（10）Sender（ 发件人的邮件地址） : 字符串
如：JMail.Sender = "sender@mailhost.com"

（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( "info@dimac.net" );

（18）AddRecipientBCC( Email )，密件收件人：
如：JMail.AddRecipientBCC( "anyone@mailhost.com" );

（19）AddRecipientCC( Email ) ，抄送收件人：
如：JMail.AddRecipientCC( "anyone@mailhost.com" )

（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