用VBA操纵Lotusnotes发邮件

1、287 ,用lotus notes 发送邮件,第一种方法，Sub Sen dWithLotus()Dim n oSessi on As Object, n oDatabase As ObjectDim n oDocume nt As Object, no Attachme nt As ObjectDim FileSelf As Stri ngDim i As LongConst EMBED_ATTACHMENT = 1454Const stSubject As Stri ng = For Lotus VBA Programmi ng Test onlyDim stMsg As Stri ngF

2、ileSelf = ThisWorkbook.Path + + ThisWorkbook.NamestMsg = Bst & Rgds & vbCrLf & _Applicatio n.UserName & vbCrLf & _vbCrLf & _H*“ vbCrLf &message.)Dim vaRecipient As VariantInsert Lotus Notes COM object.Set noSession = CreateObject(Notes.NotesSession)Set noDatabase = noSession.GETDATABASE(,D:notesdata

3、mail3tonyhf.nsf)If noDatabase.IsOpen = False Then noDatabase.OPENMAILSet noDocument = noDatabase.CREATEDOCUMENTSet noAttachment = noDocument.CREATERICHTEXTITEM(Body)noAttachment.EMBEDOBJECT EMBED_ATTACHMENT, , FileSelfWith noDocument.Form = Memo.SendTo = vaRecipient.Subject = stSubject.Body = stMsg.

4、SAVEMESSAGEONSEND = True.PostedDate = Now().SEND 0, vaRecipientEnd WithSet noDocument = NothingSet noDatabase = NothingSet noSession = NothingAppActivate Microsoft ExcelMsgBox This file be sent, vbInformationEnd Sub第二种方法Sub SendWithLotus()Dim noSession As Object, noDatabase As ObjectDim noDocument A

5、s 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 you! just for reference & vbCrLf & Iam StanleyPanDim vaRecipient As VariantFilervaFiles = Applicatio

6、n.GetOpenFilename(FileFilter:=Excel(*.xls),*.xls, Title:=Attach files for outgoing E_Mail, MultiSelect:=True)If Not IsArray(vaFiles) Then Exit SubInsert Lotus Notes COM object.Set noSession = CreateObject(Notes.NotesSession)Set noDatabase = noSession.GETDATABASE(,D:notesdatamail3tonyhf.nsf)If noData

7、base.IsOpen = False Then noDatabase.OPENMAILSet noDocument = noDatabase.CREATEDOCUMENTSet noAttachment = noDocument.CREATERICHTEXTITEM(Body)With noAttachmentFor i = 1 To UBound(vaFiles).EMBEDOBJECT EMBED_ATTACHMENT, , vaFiles(i)Next iEnd WithWith n oDocume nt.Form = Memo.Se ndTo = vaRecipie nt.Subje

8、ct = stSubject.Body = stMsg.SAVEMESSAGEONSEND = True.PostedDate = Now().SEND 0, vaRecipie ntEnd WithSet n oDocume nt = Noth ingSet n oDatabase = Nothi ngSet no Sessi on = Noth ingAppActivate Microsoft ExcelMsgBox This file is send OK, vbl nformatio nEnd Sub1, 返回当前数据库的信息,a, 返回当前数据库的名称，结果，b, 返回当前数据库的文

9、件名，c, 返回当前数据库的文件路径，2, 发送邮件的一些设置，Sub aaaaaa()Dim no As ObjectDim db As ObjectDim doc As ObjectDim fields As ObjectDim no fields As ObjectDim att As Varia ntatt = Applicatio n.GetOpe nFile name(FileFilter:=Excel Filer (*.xls),*.xls, _添加附件Title:=Attach files for outgoing E_Mail, MultiSelect:=True)Set n

10、o = CreateObject(” notes, notessessio n)建立和邮件的连接Set db = no .CURRENTDATABASE建立和邮件数据库的连接Set doc = db.CREATEDOCUMENT创建一个新的邮件Set fields = doc.CREATERICHTEXTITEM(body) 设置新邮件的正文(附件)对象With fields 设置邮件的正文和附件.APPENDTEXT this e-mail is generated by an automated process just for a test.ADDNEWLINE 1 增加第一行.APPE

11、NDTEXT 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 just for testing 主题.SAVEMESSAGEONSEND = True 是 否保存发送的邮件到发件箱.postdate = DateAdd(d, 1, Date) 发送日期等于当天.SEND 0 发送End WithM

12、sgBox successfully sent out the mail!Set no = Nothi ng 释放内存Set db = Noth ingSet doc = Nothi ngSet fields = Nothi ngEnd Sub在添加附件的时候，如果只是想将当前的活动工作薄作为附件的话，如下，注意一下,如果是1452的话,效果如下,会出现一个提示，询问文档包含外部对象链接，是否要更新链接，如果确定的话，效果如下，会将EXCEL文件中的内容以图片形式打开,同时文件是只读格式的,如果是1453,效果如下,不会有提示，但是文件为只读，如果为1454,则为正常的EXCEL文件格式,3,

13、 提取邮件的一些信息，以上的发件人，发送时间，主题等信息还可以如下表示，运行结果，4, 指定是在收件箱，发件箱或其他自定义的文件夹，a, 收件箱等邮箱本身就存在的，b, 如果是自己创建的文件夹及子文件夹，比如在我的邮箱中有自定义的文件夹，folders,如果要想获取其下面的子文件夹之一的相关资料，则应如下书写，4, 用上面的方法提取出来的发件人是有公司名称的，an otes.CREATENAME(adocume nt.GETITEMVALUE(from)(0).ABBREVIATED如果不使用abbreviated, 则结果为，如果想要输出的发件人只有名字，没有公司名的话，可以做如下更改，结果

14、为，排版之后的效果如下所示，5, 如果想要将附件保存到指定的文件夹的话，以上代码是将发件箱中的附件保存到 D盘的新建文件夹，以下将发件箱改成自定义的文件夹，”HR in formatio n ”6, 用以下方法也可以获得附件的名称,结果, 也可以将 oemb.source 改成 ,结果一样，结果，以上代码是获取发件箱中的第一个邮件的附件名称，7, 设置发送邮件时的邮件正文，以上的代码中，其实 with fields 和with doc都是设置邮件的正文,with fields,是设置邮件的正文和附件信息，with doc,是设置邮件的发送人，是否保存到发件箱等一些其他的信息，

15、8, 在发送邮件的时候，要注意 body的问题，a,如果自始至终都使用body来添加附件和正文的话，则添加的正文就不会出现，就只有 附件，发送后的结果，注意，以上发送出去的邮件是没有正文的，只有附件，就是说以上的代码用with doc添加的body正文没有添加成功，如果想要有正文的话，有两个办法，第一，将第一个括号里面的body改成和第三个红框里面的body不同的字符， 结果,注意，这样更改后的结果就是，发送的邮件的正文文本和附件之间有一条线分隔, 第二种方法， 就是用appendtext方法添加空行的方法，以上的代码就是通过添加空行，添加文本的方法来添加正文文本部分, 结果，9,枚举所有fo

16、lder的名称，结果，以上代码是返回所有的文件夹，以下的代码返回的是非文件夹， 结果,10,如果想要将发件人的名称改成其他的名称，比如 group sender,可以做如下设置,请注意以上代码中的红色框框部分，加上doc.principal =“group sender ”， 收到的邮件的发件人就会显示group sen der,结果,11, 如果在没有打开邮箱的情况下想发送邮件，可以设置如下Sub abb()Dim MailDoc As ObjectDim Maildb As ObjectDim Body As ObjectDim Session As ObjectStart a sessi

17、on 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 the current IDCall Session.Initialize()Open the mail database in notesSet Maildb = Session.GETDATABASE(, D:notesdatamail3t

18、onyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfCreate the mail documentCall MailDoc.REPLACEITEMVALUE(Form, Memo)Set MailDoc = Maildb.CREATEDOCUMENTSet the recipient Set subjectCall MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Create and set the Body contentSet Body = MailDoc.CREAT

19、ERICHTEXTITEM(Body)Call Body.APPENDTEXT(Body text here)Example to create an attachment (optional)Call Body.ADDNEWLINE(2)Call Body.EMBEDOBJECT(1454, , ActiveWorkbook.FullName)Example to save the message (optional)MailDoc.SAVEMESSAGEONSEND = TrueSend the documentGets the mail to appear in the Sent ite

20、ms folderCall MailDoc.REPLACEITEMVALUE(PostedDate, Now()Clean UpCall MailDoc.SEND(False)Set Maildb = Nothi ngSet MailDoc = Nothi ngSet Body = Nothi ngSet Sessi on = Nothi ngEnd Sub结果, 首先会要求输入密码，这样的话，不用打开lotus notes 就可以发送邮件了如果不想每次都手动的输入密码的话，可以如下设置，call sessi on.i n itialize(“密码”)Sub abb()Dim Maildb A

21、s ObjectDim MailDoc As ObjectDim Body As ObjectDim Sessi on As ObjectSet Sessi on = CreateObject(lotus.NotesSessi on)Call Session.Initialize(ilove1237)Set Maildb = Session.GETDATABASE(, D:notesdatamail3tonyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfSet MailDoc = Maildb.CREATEDOCUME

22、NTCall MailDoc.REPLACEITEMVALUE(Form, Memo)Call MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Set Body = MailDoc.CREATERICHTEXTITEM(Body)Call Body.APPENDTEXT(Body text here)Call Body.ADDNEWLINE(2)Call Body.EMBEDOBJECT(1454, , ActiveWorkbook.FullName)MailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPL

23、ACEITEMVALUE(PostedDate, Now()Set Maildb = NothingSet MailDoc = Nothi ngSet Body = Nothi ngSet Sessi on = Nothi ngMsgBox 发送成功!End Sub结果如下,12, 如果想要设置发送邮件时候的抄送等信息，设置如下,结果, 如果想要发送给多个收件人，则设置如下, 结果,13, 如果想要在发出的邮件中添加当前的签名的话，可以设置如下,其中，如果当前的签名不是文本，而是图片的话，这句代码就会返回作为当前签名的图片的名称和存放地址， 说明我当前的签名图片是存放在 D盘的photo1文件

24、夹中的，图片名称为邮件,如下, 最后发送出去的结果如下所示,可以看到，签名在此时就是图片的地址，因为其不是一段文本，所以才会这样, 而如果签名为文本的时候，效果如下，以上就是上面这句代码返回的文本签名的内容,发送出去的邮件如下所示，14, 如果想要进行正文文本的排版的话（即分段隔行等），设置如下,注意几个地方, 一个是addnewline,在一句话完了之后的第一个 vbnewline是起换行的作用，而第二个 vbnewline才是新添加一个空行，二个是在这种情况下，如果通过 doc的body属性添加正文文本的话，则在声明fields的 时候，不能也使用body,要使用不同于body的名字，效果

25、如下，要达到同样的效果，还有一种方法，请注意，上面的代码中，有addnewline，在其后面的数字表示添加的行数，一般如果是隔 行的话，则要添加两行，一行起换行作用，一行为添加的空行， 最终效果如下,15, 返回邮件服务器的名称,结果,结果,16, 返回notes的用户名,1,结果,2,结果,17, 打开一个新邮件，并且将光标移到发件人，抄送人，或正文等处Sub aaa()Dim ano tesDim aDataBaseDim aviewDim itotalDim adocume ntDim wsDim no tesdocSet ws = CreateObject(Notes.NotesUIW

26、orkspace)Set anotes = CreateObject(Notes.NotesSessio n)Set aDataBase = an otes.GETDATABASE(, D:notesdatamail3to nyhf. nsf)Set no tesdoc = aDataBase.CREATEDOCUMENTSet uidoc = ws.EDITDOCUMENT(True, notesdoc)Call uidoc.GOTOFIELD(Body)End Sub执行完以上的代码之后，光标会移到邮件的正文，处于编辑状态，如果将body换成subject的话，光标就会处于收件人处，18,

27、 如何根据工作表中多个邮箱地址发邮件,Sub发送邮件()Dim Maildb As ObjectDim MailDoc As ObjectDim Body As ObjectDim Sessi on As ObjectDim attDim arrx = Sheets(1).Range(a65536).End(xlUp).RowReDim arr(1 To x)For y = 1 To xarr(y) = Sheets(1).Cells(y, 1)Next y添加附件att = Application.GetOpenFilename(FileFilter:=Excel Filer (*.xls)

28、,*.xls, _Title:=Attach files for outgoing E_Mail, MultiSelect:=True) Set Session = CreateObject(lotus.NotesSession)Session.Initialize (ilove1237)Set Maildb = Session.GETDATABASE(, D:notesdatamail3tonyhf.nsf)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfSet MailDoc = Maildb.CREATEDOCUMENTCall

29、 MailDoc.REPLACEITEMVALUE(Form, Memo)Call MailDoc.REPLACEITEMVALUE(SendTo, arr)Call MailDoc.REPLACEITEMVALUE(Subject, Subject Text)Set Body = MailDoc.CREATERICHTEXTITEM(Body)Call Body.APPENDTEXT(Body text here)Call Body.ADDNEWLINE(2)For i = 1 To UBound(att)Call Body.EMBEDOBJECT(1454, , att(i)Next iM

30、ailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPLACEITEMVALUE(PostedDate, Now()Call MailDoc.SEND(False)Set Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingMsgBox 发送成功 !End Sub结果,19,如何用VBS发邮件,Dim mydocu , os , myBodySet os = CreateObject(Notes.NotesSessio n)Set myBody = myD

31、ocu.CREATERICHTEXTITEM(Body)with mybody.appe ndtext this e-mail is gen erated by automated process, you dont n eed toreply.add newli ne 2桌面 overhead group.xlsend with with mydocu.CopyTo =.Subject = this is for test.SEND 0 end withSet myDocu = Nothi ngSet myBody = Nothi ngSet os = Nothi ng发送方法，双击VBS图

32、标即可，20,如何将excel的部分内容作为richtext 格式粘贴在邮件中,Sub aa()Dim no As ObjectDim db As ObjectDim clipboard As DataObjectDim doc As ObjectDim field As ObjectSet no = CreateObject(” notes, notessessio n)建立和邮件的连接Set db = no .Curre ntDatabaseSet doc = db.CreateDocume ntSet field = doc.CreateRichTextltem(body)Selecti

33、on.CopySet clipboard = New DataObjectclipboard.GetFromClipboardWith field.AppendText 此邮件为系统自动发送，请不要回复，仅作为测试使用！.AddNewLine 2.AppendText clipboard.GetText(1)End WithWith doc.form = Memo.Subject = 自动邮件 .SaveMessageOnSend = True.postdate = Now().Send 0End WithSelection(1).SelectApplicati on .CutCopyMode

34、 = FalseEnd Sub发送的效果如下图21, 在发送附件的时候要注意的问题以下的代码的目的是发送带附件的邮件，但是有个问题值得注意：下面的正文部分和收件 人信息部分不能置换位置，如果将收件人信息放在正文上方，则发出的邮件正文部分为空 白，22, 如何避免在用循环发送多个邮件的时候，出现所有的附件都集中在一个邮件中的情况，如果以上面的代码发送邮件的话，就会出现所有的邮件都集中在一个邮件中的情况，效果如下，原因为：VBA和Lotus notes执行不同步造成的,因为当lotus notes还没有处理完前一个邮件的时候，VBA已经执行到下一个循环了 ,解决办法：执行完一个循环，就将设置正文及

35、标题信息的doc对象设置成nothing,然后到下一个循环的时候，再用set函数创建， 发送后的效果如下所示23, notesview 的 type 值,ACTIONCD (16) means saved actio n CD records; non-Computable; canoni cal form.ASSISTANTINFO (17) means saved assistant information; non-Computable; canonical form.ATTACHMENT (1084) means file attachment.AUTHORS (1076) means

36、 authors.COLLATION (2).Note This value is new with Release 6.DATETIMES (1024) means date-time value or range of date-time values.EMBEDDEDOBJECT (1090) means embedded object.ERRORITEM (256) means an error occurred while accessing the type.FORMULA (1536) means Notes formula.HTML (21) means HTML source

37、 text.ICON (6) means icon.LSOBJECT (20) means saved LotusScript Object code for an agent.MIME_PART (25) means MIME support.NAMES (1074) means names.NOTELINKS (7) means link to a database, view, or document.NOTEREFS (4) means reference to the parent document.NUMBERS (768) means number or number list.

38、OTHEROBJECT (1085) means other object.QUERYCD (15) means saved query CD records; non-Computable; canonical form.READERS (1075) means readers.RFC822Text (1282) means RFC822 Internet mail text.RICHTEXT (1) means rich text.SIGNATURE (8) means signature.TEXT (1280) means text or text list.UNAVAILABLE (5

39、12) means the item type isnt available.UNKNOWN (0) means the item type isnt known.USERDATA (14) means user data.USERID (1792) means user ID name.form.form.VIEWMAPDAT(1A8) meanssaved ViewMapdataset; non-Computable; canonical? VIEWMAPLAYO(U1T9) meanssaved ViewMaplayout; non-Computable; canonical以下代码返回

40、in box中的最后一圭寸邮件的bod y的类型,Sub Click()Dim sessionDim dbDim viewDim docDim entDim filDim iteDim doc1Dim embfil = 0ite = 0emb = 0Set session = CreateObject(notes.notessession)Set db = session.GETDATABASE(, d:notesdatamail3tonyhf.nsf)Set view = db.GetView($inbox)Set doc = view.getlastdocumentSet docl = d

41、oc.getfirstitem(body)MsgBox docl.TypeEnd sub结果24, notesdocument 和 notesrichtextitem在有附件时候的区别结果是不支持也就是说,notesdocument 是支持 hasembedded属性的，而 notesrichtextitem的，同时,noteitem也没有这个属性，因为richtextitem 是item的一种子类型，注意以下的语句，想通过以上的代码首先判断最后一封邮件中是否有附件，如果有，则依次返回其名称,结果，原因如下，Un like the EmbeddedObjects property in Not

42、esRichTextltem, this property does not include file attachments, nor OLE/1 objects created in Notes Release 3.This property does include OLE/2 and OLE/1 objects created in Notes Release 4. It also includes objects in the document that were originally embedded in theindocuments form. Such objects mus

43、t have been activated, modified, and re-saved order to be returned by this property (otherwise they rema in a part of the form, not the docume nt）.doc1,所以要想达到以上效果，要通过 notesrichtextitem 对象，即上面的代码中定义的但是doc1没有hasembedded这个属性可以判断是否包括附件，但是要判断是否包含附件，可以通过 notesdocument对象的的hasembedded属性，结果,25, item 中的 eleme

44、nt.使用 getfirstelement,如果使用findfirstelement,则有以下type,26, 返回邮件正文（不包括签名）,- 包括发件人，时间，收件人，抄送，主题,Sub Click()Dim sessi onDim dbDim viewDim docDim entDim filDim iteDim doc1Dim embSet session = CreateObject(notes.notessession)Set db = session.GETDATABASE(, d:notesdatamail3tonyhf.nsf)Set view = db.GetView($in

45、box)Set doc = view.getlastdocumentSet doc1 = doc.getfirstitem(body)Set ent = doc1.createnavigatorIf ent.findfirstelement(4) ThenDoSet emb = doc1.createrangeCall emb.setbegin(ent)MsgBox emb.textparagraphLoop Until Not ent.findnextelement(4)End IfEnd Sub结果,26,关闭当前打开的邮件窗口Sub a()Dim workspaceDim uidocDi

46、m uidoc1Set workspace = CreateObject(” no tes. no tesuiworkspace)Set uidoc = workspace.Curre ntdocume ntCall uidoc.CloseEnd Sub结果，27, 如何返回当前打开邮件的相关信息返回正文部分,发件人收件人抄送秘密抄送正文 另外一种返回此上信息的方法是通过 notesdocument对象的getitemvalue方法,返回正文,和通过notesuidocument对象的fieldgettext方法相比,优点在于：返回的正文的文本格式没有变化，28, 如何设置文字的格式-CREA

47、TERICHTEXTSTYLESub aaaaaa()Dim no As ObjectDim db As ObjectDim doc As ObjectDim fields As ObjectDim no fields As ObjectDim att As Varia nt建立和邮件的连接Dim style As ObjectSet no = CreateObject(” no tes .no tessessio n)Set db = no .CURRENTDATABASE建立和邮件数据库的连接Set doc = db.CREATEDOCUMENT创建一个新的邮件Set fields = d

48、oc.CREATERICHTEXTITEM(body) 设置新邮件的正文(附件)对象Set style = no.CREATERICHTEXTSTYLEWith fields 设置邮件的正文和附件style.notescolor = 3 style.Bold = True style.FontSize = 12 .APPENDSTYLE style .APPENDTEXT This is an example! style.notescolor = 4 style.Bold = True style.FontSize = 14 .APPENDSTYLE style .APPENDTEXT He

49、llo, style.notescolor = 5style.Bold = True style.FontSize = 16 .APPENDSTYLE style .APPENDTEXT World! style.notescolor = 6 style.Bold = True style.FontSize = 18 .APPENDSTYLE style .APPENDTEXT LOL!End WithWith doc 设置新邮件的除正文和附件外的其他信息.form = Memo 新邮件.Subject = this mail is just for testing 主题发送日期等于当天.SA

50、VEMESSAGEONSEND = True 是 否保存发送的邮件到发件箱 .postdate = DateAdd(d, 1, Date) .send 0发送End WithMsgBox successfully sent out the mail!Set no = Nothi ng 释放内存Set db = Noth ingSet doc = Nothi ngSet fields = Nothi ngEnd Sub结果如何判断NOTE是否有打开用database的isopen属性来判断Open DataBase。Dim aNotesDim aDataBaseDim strTemp As St

51、ri ngSet aNotes = CreateObject(Notes.NotesSessio n)Set aDataBase = aNotes.CURRENTDATABASEIf aDataBase.IsOpen ThenMsgBox Is OpenElseMsgBox Not OpenEnd IfIf aDataBase.IsOpen ThenMsgBox aDataBase.Title & 已打开 & vbcrlf & aDataBase.FilenameElseMsgBox 未打开 , , aDataBase.FilenameEnd IfSet aNotes = NothingSet

52、 aDataBase = NothingSub果上面显示的数据库是当前打开的数据库中的活动数据库 果我激活另外的打开的数据库，结果就会不同，如何在邮件中添加表格-richtextitem, appe ndtableaaaaaa()no As Objectdb As Objectdoc As Objectfields As Objectatt() As Stri ngnrtn As Objectx, y As In tegerno = CreateObject(” notes, notessessio n)建立和邮件的连接db = no .CURRENTDATABASE建立和邮件数据库的连接do

53、c = db.CREATEDOCUMENT创建一个新的邮件fields = doc.CREATERICHTEXTITEM(body) 设置新邮件的正文(附件)对象nrtn = fields.CREATENAVIGATORIds.APPENDTABLE 11,4n.F INDFIRSTELEMENT RTELEM_TYPE_TABLECELLx = 1 To 11For y = 1 To 4fields.BEGININSERT nrtn fields.APPENDTEXT Sheets(1).Cells(x, y).Value fields.ENDINSERTnrtn.FINDNEXTELEME

54、NT RTELEM_TYPE_TABLECELL Next yt xh doc 设置新邮件的除正文和附件外的其他信息.form = Memo 新邮件.Subject = this mail is just for testing 主题 .SAVEMESSAGEONSEND = Tri是否保存发送的邮件到发件箱 .postdate = DateAdd(d, 1, Date) 发送日期等于当天 .SEND 0 发送WithBox successfully sent out the mail!no = Noth ing 释放内存db = Nothi ngdoc = Nothi ngfields = Nothi ngnrtn = Nothi ngSub面的RTELEM_TYPE_TABLEC也相当于一个常量数字7果在添加