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