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