Lotus Notes Send EMail from VB or VBA

'Public Sub SendNotesMail(Subject as string, attachment as string,

'recipient as string, bodytext as string,saveit as Boolean)

'函数功能：发送带附件的邮件给recipient变量中指定的收件人

'运行环境：安装并配置好Notes客户端.

Public Sub SendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean)

'设置对象属性Set up the objects required for Automation into lotus notes

Dim Maildb As Object 'The mail database

Dim UserName As String 'The current users notes name

Dim MailDbName As String 'THe current users notes mail database name

Dim MailDoc As Object 'The mail document itself

Dim AttachME As Object 'The attachment richtextfile object

Dim Session As Object 'The notes session

Dim EmbedObj As Object 'The embedded object (Attachment)

'创建Notes会话

Set Session = CreateObject("Notes.NotesSession")

'就想帮助文件里面提到的那样，COM用户必须先初始化会话方可继续Domino对象的操控，仅适用于 5.x 以上版本.

Session.Initialize("password")

'取得用户名并计算邮件文件名

'在某些情况，假如你传递一个空字符串到 MailDBname 变量，一样能够发送邮件，只要ID口令正确就可以了.

UserName = Session.UserName

MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

'打开Notes邮箱

Set Maildb = Session.GETDATABASE("", MailDbName)

If Maildb.ISOPEN = True Then

'判断已经打开

Else

Maildb.OPENMAIL

End If

'创建新邮件

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"

MailDoc.sendto = Recipient

MailDoc.Subject = Subject

MailDoc.Body = BodyText

MailDoc.SAVEMESSAGEONSEND = SaveIt

'设置嵌入对象，添加附件

If Attachment <> "" Then

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")

'Attachment格式为：c:\my documents\report.doc

'下一行要注释掉，不然会出现"Rich text item Attachment already exists."的错误提示

MailDoc.CREATERICHTEXTITEM ("Attachment")

End If

'发送文档

MailDoc.PostedDate=Now() '加上PostedDate，邮件就会出现在发件箱

MailDoc.SEND 0, Recipient

MsgBox "发送完毕！"

'清理状态

Set Maildb = Nothing

Set MailDoc = Nothing

Set AttachME = Nothing

Set Session = Nothing

Set EmbedObj = Nothing

End Sub

MailDoc.CopyTo = ccRecipient

MailDoc.BlindCopyTo = bccRecipient

recip(0) = "emailaddress1"

recip(1) = "emailaddress2"

'等等..

maildoc.sendto = recip