用VBA操纵Lotusnotes发邮件.docx

1、用VBA操纵Lotusnotes发邮件287 , 用lotus notes发送邮件，第一种方法，Sub SendWithLotus()Dim noSession As Object, noDatabase As ObjectDim noDocument As Object, noAttachment As ObjectDim FileSelf As StringDim i As LongConst EMBED_ATTACHMENT = 1454Const stSubject As String = For Lotus VBA Programming Test onlyDim stMsg As

2、StringFileSelf = ThisWorkbook.Path + + ThisWorkbook.NamestMsg = Bst & Rgds & vbCrLf & _ Application.UserName & vbCrLf & _ vbCrLf & _ * & vbCrLf & _ (Thiss an automated e-mail notification, please do not reply this message.)Dim vaRecipient As Variant Insert Lotus Notes COM object. Set noSession = Cre

3、ateObject(Notes.NotesSession) Set noDatabase = noSession.GETDATABASE(, D:notesdatamail3tonyhf.nsf) If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Set noDocument = noDatabase.CREATEDOCUMENT Set noAttachment = noDocument.CREATERICHTEXTITEM(Body) noAttachment.EMBEDOBJECT EMBED_ATTACHMENT, , File

4、Self With noDocument .Form = Memo .SendTo = vaRecipient .Subject = stSubject .Body = stMsg .SAVEMESSAGEONSEND = True .PostedDate = Now() .SEND 0, vaRecipient End With Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing AppActivate Microsoft Excel MsgBox This file be sent, vbInf

5、ormationEnd Sub第二种方法Sub SendWithLotus()Dim noSession As Object, noDatabase As ObjectDim noDocument As Object, noAttachment As ObjectDim vaFiles As VariantDim i As LongConst EMBED_ATTACHMENT = 1454Const stSubject As String = For Lotus VBA Programming Test onlyConst stMsg As String = This file is for

6、you! just for reference & vbCrLf & I am StanleyPanDim vaRecipient As Variant vaFiles = Application.GetOpenFilename(FileFilter:=Excel Filer (*.xls),*.xls, Title:=Attach files for outgoing E_Mail, MultiSelect:=True) If Not IsArray(vaFiles) Then Exit Sub Insert Lotus Notes COM object. Set noSession = C

7、reateObject(Notes.NotesSession) Set noDatabase = noSession.GETDATABASE(, D:notesdatamail3tonyhf.nsf) If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Set noDocument = noDatabase.CREATEDOCUMENT Set noAttachment = noDocument.CREATERICHTEXTITEM(Body) With noAttachment For i = 1 To UBound(vaFiles)

8、.EMBEDOBJECT EMBED_ATTACHMENT, , vaFiles(i) Next i End With With noDocument .Form = Memo .SendTo = vaRecipient .Subject = stSubject .Body = stMsg .SAVEMESSAGEONSEND = True .PostedDate = Now() .SEND 0, vaRecipient End With Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing AppA

9、ctivate Microsoft Excel MsgBox This file is send OK, vbInformationEnd Sub1, 返回当前数据库的信息，a, 返回当前数据库的名称，结果，b, 返回当前数据库的文件名，c, 返回当前数据库的文件路径，2，发送邮件的一些设置，Sub aaaaaa()Dim no As ObjectDim db As ObjectDim doc As ObjectDim fields As ObjectDim nofields As ObjectDim att As Variantatt = Application.GetOpenFilenam

10、e(FileFilter:=Excel Filer (*.xls),*.xls, _Title:=Attach files for outgoing E_Mail, MultiSelect:=True) 添加附件Set no = CreateObject(notes.notessession) 建立和邮件的连接Set db = no.CURRENTDATABASE 建立和邮件数据库的连接Set doc = db.CREATEDOCUMENT 创建一个新的邮件Set fields = doc.CREATERICHTEXTITEM(body) 设置新邮件的正文（附件）对象With fields 设

11、置邮件的正文和附件 .APPENDTEXT this e-mail is generated by an automated process just for a test .ADDNEWLINE 1 增加第一行 .APPENDTEXT please do not reply. .ADDNEWLINE 2 增加第二行 For i = 1 To UBound(att) 添加附件 .EMBEDOBJECT 1454, , att(i) Next iEnd WithWith doc 设置新邮件的除正文和附件外的其他信息 .form = Memo 新邮件 .Subject = this mail is

12、 just for testing 主题 .SAVEMESSAGEONSEND = True 是否保存发送的邮件到发件箱 .postdate = DateAdd(d, 1, Date) 发送日期等于当天 .SEND 0 发送End WithMsgBox successfully sent out the mail!Set no = Nothing 释放内存Set db = NothingSet doc = NothingSet fields = NothingEnd Sub在添加附件的时候，如果只是想将当前的活动工作薄作为附件的话，如下，注意一下, 如果是1452的话, 效果如下, 会出现一个

13、提示, 询问文档包含外部对象链接, 是否要更新链接, 如果确定的话, 效果如下, 会将EXCEL文件中的内容以图片形式打开, 同时文件是只读格式的, 如果是1453, 效果如下, 不会有提示, 但是文件为只读, 如果为1454, 则为正常的EXCEL文件格式, 3, 提取邮件的一些信息，以上的发件人，发送时间，主题等信息还可以如下表示，运行结果，4，指定是在收件箱，发件箱或其他自定义的文件夹，a, 收件箱等邮箱本身就存在的，b, 如果是自己创建的文件夹及子文件夹，比如在我的邮箱中有自定义的文件夹，folders, 如果要想获取其下面的子文件夹之一的相关资料，则应如下书写，4, 用上面的方法提取

14、出来的发件人是有公司名称的，anotes.CREATENAME(adocument.GETITEMVALUE(from)(0).ABBREVIATED如果不使用abbreviated, 则结果为，如果想要输出的发件人只有名字，没有公司名的话，可以做如下更改，结果为，排版之后的效果如下所示，5, 如果想要将附件保存到指定的文件夹的话，以上代码是将发件箱中的附件保存到D盘的新建文件夹，以下将发件箱改成自定义的文件夹，”HR information”6, 用以下方法也可以获得附件的名称，结果，也可以将oemb.source改成oemb.name, 结果一样，结果，以上代码是获取发件箱中的第一个邮件的

15、附件名称，7, 设置发送邮件时的邮件正文，以上的代码中，其实with fields和with doc都是设置邮件的正文，with fields, 是设置邮件的正文和附件信息，with doc, 是设置邮件的发送人，是否保存到发件箱等一些其他的信息，8, 在发送邮件的时候，要注意body的问题，a, 如果自始至终都使用body来添加附件和正文的话，则添加的正文就不会出现，就只有附件，发送后的结果，注意，以上发送出去的邮件是没有正文的，只有附件，就是说以上的代码用with doc添加的body正文没有添加成功，如果想要有正文的话，有两个办法，第一， 将第一个括号里面的body改成和第三个红框里面的

16、body不同的字符，结果，注意，这样更改后的结果就是，发送的邮件的正文文本和附件之间有一条线分隔，第二种方法， 就是用appendtext方法添加空行的方法，以上的代码就是通过添加空行，添加文本的方法来添加正文文本部分，结果，9, 枚举所有folder的名称，结果，以上代码是返回所有的文件夹，以下的代码返回的是非文件夹，结果，10, 如果想要将发件人的名称改成其他的名称，比如group sender, 可以做如下设置，请注意以上代码中的红色框框部分，加上doc.principal = “group sender”， 收到的邮件的发件人就会显示group sender, 结果，11, 如果在没有

17、打开邮箱的情况下想发送邮件，可以设置如下Sub abb()Dim Maildb As ObjectDim MailDoc As ObjectDim Body As ObjectDim Session As ObjectStart a session to notesSet Session = CreateObject(Lotus.NotesSession)This line prompts for password of current ID noted in Notes.INICall Session.Initializeor use below to supply password of

18、the current IDCall Session.Initialize()Open the mail database in notesSet Maildb = Session.GETDATABASE(, D:notesdatamail3tonyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfCreate the mail documentSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE(Form, Memo)Set the recipi

19、entSet subjectCall MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Create and set the Body contentSet Body = MailDoc.CREATERICHTEXTITEM(Body)Call Body.APPENDTEXT(Body text here)Example to create an attachment (optional)Call Body.ADDNEWLINE(2)Call Body.EMBEDOBJECT(1454, , ActiveWorkbook.FullName)Examp

20、le to save the message (optional)MailDoc.SAVEMESSAGEONSEND = TrueSend the documentGets the mail to appear in the Sent items folderCall MailDoc.REPLACEITEMVALUE(PostedDate, Now()Call MailDoc.SEND(False)Clean UpSet Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingEnd Sub结果，首

21、先会要求输入密码，这样的话，不用打开lotus notes就可以发送邮件了如果不想每次都手动的输入密码的话，可以如下设置，call session.initialize(“密码”)Sub abb()Dim Maildb As ObjectDim MailDoc As ObjectDim Body As ObjectDim Session As ObjectSet Session = CreateObject(lotus.NotesSession)Call Session.Initialize(ilove1237)Set Maildb = Session.GETDATABASE(, D:note

22、sdatamail3tonyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE(Form, Memo)Call MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Set Body = MailDoc.CREATERICHTEXTITEM(Body)Call Body.APPENDTEXT(Body text here)Call Body.ADDNEWLI

23、NE(2)Call Body.EMBEDOBJECT(1454, , ActiveWorkbook.FullName)MailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPLACEITEMVALUE(PostedDate, Now()Call MailDoc.SEND(False)Set Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingMsgBox 发送成功!End Sub结果如下，12, 如果想要设置发送邮件时候的抄送等信息，设置如下，结果，如果想

24、要发送给多个收件人，则设置如下，结果，13, 如果想要在发出的邮件中添加当前的签名的话，可以设置如下，其中，如果当前的签名不是文本，而是图片的话，这句代码就会返回作为当前签名的图片的名称和存放地址，说明我当前的签名图片是存放在D盘的photo1文件夹中的，图片名称为邮件，如下，最后发送出去的结果如下所示，可以看到，签名在此时就是图片的地址，因为其不是一段文本，所以才会这样，而如果签名为文本的时候，效果如下，以上就是上面这句代码返回的文本签名的内容，发送出去的邮件如下所示，14, 如果想要进行正文文本的排版的话（即分段隔行等），设置如下，注意几个地方，一个是addnewline, 在一句话完了之

25、后的第一个vbnewline是起换行的作用，而第二个vbnewline才是新添加一个空行，二个是在这种情况下，如果通过doc的body属性添加正文文本的话，则在声明fields的时候，不能也使用body, 要使用不同于body的名字，效果如下，要达到同样的效果，还有一种方法，请注意，上面的代码中，有addnewline，在其后面的数字表示添加的行数，一般如果是隔行的话，则要添加两行，一行起换行作用，一行为添加的空行，最终效果如下，15, 返回邮件服务器的名称，结果，结果，16, 返回notes的用户名，1, 结果，2, 结果，17, 打开一个新邮件，并且将光标移到发件人，抄送人，或正文等处Su

26、b aaa() Dim anotes Dim aDataBase Dim aview Dim itotal Dim adocument Dim ws Dim notesdoc Set ws = CreateObject(Notes.NotesUIWorkspace) Set anotes = CreateObject(Notes.NotesSession) Set aDataBase = anotes.GETDATABASE(, D:notesdatamail3tonyhf.nsf) Set notesdoc = aDataBase.CREATEDOCUMENT Set uidoc = ws.

27、EDITDOCUMENT(True, notesdoc) Call uidoc.GOTOFIELD(Body)End Sub执行完以上的代码之后，光标会移到邮件的正文，处于编辑状态，如果将body换成subject的话，光标就会处于收件人处，18, 如何根据工作表中多个邮箱地址发邮件，Sub 发送邮件()Dim Maildb As ObjectDim MailDoc As ObjectDim Body As ObjectDim Session As ObjectDim attDim arrx = Sheets(1).Range(a65536).End(xlUp).RowReDim arr(1

28、To x)For y = 1 To x arr(y) = Sheets(1).Cells(y, 1)Next yatt = Application.GetOpenFilename(FileFilter:=Excel Filer (*.xls),*.xls, _Title:=Attach files for outgoing E_Mail, MultiSelect:=True) 添加附件Set Session = CreateObject(lotus.NotesSession)Session.Initialize (ilove1237)Set Maildb = Session.GETDATABA

29、SE(, D:notesdatamail3tonyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE(Form, Memo)Call MailDoc.REPLACEITEMVALUE(SendTo, arr)Call MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Set Body = MailDoc.CREATERICHTEXTITEM(Body)C

30、all Body.APPENDTEXT(Body text here)Call Body.ADDNEWLINE(2)For i = 1 To UBound(att) Call Body.EMBEDOBJECT(1454, , att(i)Next iMailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPLACEITEMVALUE(PostedDate, Now()Call MailDoc.SEND(False)Set Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingMsgBox 发送成功!End Su