'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