用VBA操纵Lotus notes发邮件.doc

1、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 only“Dim stMsg As StringFileSelf

2、= 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 VariantvaRecipient = VBA.Array(““)Insert Lotus Notes COM object.Set n

3、oSession = CreateObject(“Notes.NotesSession“)Set noDatabase = noSession.GETDATABASE(“, “D:notesdatamail3tonyhf.nsf“)If noDatabase.IsOpen = False Then noDatabase.OPENMAILSet noDocument = noDatabase.CREATEDOCUMENTSet noAttachment = noDocument.CREATERICHTEXTITEM(“Body“)noAttachment.EMBEDOBJECT EMBED_AT

4、TACHMENT, “, FileSelfWith noDocument.Form = “Memo“.SendTo = vaRecipient.Subject = stSubject.Body = stMsg.SAVEMESSAGEONSEND = True.PostedDate = Now().SEND 0, vaRecipientEnd WithSet noDocument = NothingSet noDatabase = NothingSet noSession = NothingAppActivate “Microsoft Excel“MsgBox “This file be sen

5、t“, vbInformationEnd 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 only“Const stMsg As String = “This

6、file is for you! just for reference“ & vbCrLf & “I am StanleyPan“Dim vaRecipient As VariantvaRecipient = VBA.Array(““, “stanley.panIsolaA“)vaFiles = Application.GetOpenFilename(FileFilter:=“Excel Filer (*.xls),*.xls“, Title:=“Attach files for outgoing E_Mail“, MultiSelect:=True)If Not IsArray(vaFile

7、s) Then Exit SubInsert Lotus Notes COM object.Set noSession = CreateObject(“Notes.NotesSession“)Set noDatabase = noSession.GETDATABASE(“, “D:notesdatamail3tonyhf.nsf“)If noDatabase.IsOpen = False Then noDatabase.OPENMAILSet noDocument = noDatabase.CREATEDOCUMENTSet noAttachment = noDocument.CREATERI

8、CHTEXTITEM(“Body“)With noAttachmentFor i = 1 To UBound(vaFiles).EMBEDOBJECT EMBED_ATTACHMENT, “, vaFiles(i)Next iEnd WithWith noDocument.Form = “Memo“.SendTo = vaRecipient.Subject = stSubject.Body = stMsg.SAVEMESSAGEONSEND = True.PostedDate = Now().SEND 0, vaRecipientEnd WithSet noDocument = Nothing

9、Set noDatabase = NothingSet noSession = NothingAppActivate “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 Ob

10、jectDim att As Variantatt = Application.GetOpenFilename(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 field

11、s = doc.CREATERICHTEXTITEM(“body“) 设置新邮件的正文（附件）对象With fields 设置邮件的正文和附件.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 d

12、oc 设置新邮件的除正文和附件外的其他信息.form = “Memo“ 新邮件.sendto = VBA.Array(““, ““) 发送给.Subject = “this mail is 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 =

13、 NothingSet fields = NothingEnd Sub在添加附件的时候，如果只是想将当前的活动工作薄作为附件的话，如下，注意一下, 如果是 1452 的话, 效果如下, 会出现一个提示, 询问文档包含外部对象链接, 是否要更新链接, 如果确定的话, 效果如下, 会将 EXCEL 文件中的内容以图片形式打开, 同时文件是只读格式的, 如果是 1453, 效果如下, 不会有提示, 但是文件为只读, 如果为 1454, 则为正常的 EXCEL 文件格式, 3, 提取邮件的一些信息，以上的发件人，发送时间，主题等信息还可以如下表示，运行结果，4，指定是在收件箱，发件箱或其他自定义的文件

14、夹，a, 收件箱等邮箱本身就存在的，b, 如果是自己创建的文件夹及子文件夹，比如在我的邮箱中有自定义的文件夹，folders, 如果要想获取其下面的子文件夹之一的相关资料，则应如下书写，4, 用上面的方法提取出来的发件人是有公司名称的，anotes.CREATENAME(adocument.GETITEMVALUE(“from“)(0).ABBREVIATED如果不使用 abbreviated, 则结果为，如果想要输出的发件人只有名字，没有公司名的话，可以做如下更改，结果为，排版之后的效果如下所示，5, 如果想要将附件保存到指定的文件夹的话，以上代码是将发件箱中的附件保存到 D 盘的新建文件夹

15、，以下将发件箱改成自定义的文件夹，”HR information”6, 用以下方法也可以获得附件的名称，结果，也可以将 oemb.source 改成 oemb.name, 结果一样，结果，以上代码是获取发件箱中的第一个邮件的附件名称，7, 设置发送邮件时的邮件正文，以上的代码中，其实 with fields 和 with doc 都是设置邮件的正文，with fields, 是设置邮件的正文和附件信息，with doc, 是设置邮件的发送人，是否保存到发件箱等一些其他的信息，8, 在发送邮件的时候，要注意 body 的问题，a, 如果自始至终都使用 body 来添加附件和正文的话，则添加的正文

16、就不会出现，就只有附件，发送后的结果，注意，以上发送出去的邮件是没有正文的，只有附件，就是说以上的代码用 with doc 添加的 body 正文没有添加成功，如果想要有正文的话，有两个办法，第一， 将第一个括号里面的 body 改成和第三个红框里面的 body 不同的字符，结果，注意，这样更改后的结果就是，发送的邮件的正文文本和附件之间有一条线分隔，第二种方法， 就是用 appendtext 方法添加空行的方法，以上的代码就是通过添加空行，添加文本的方法来添加正文文本部分，结果，9, 枚举所有 folder 的名称，结果，以上代码是返回所有的文件夹，以下的代码返回的是非文件夹，结果，10,

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

18、s.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:notesdatamail3tonyhf.nsf“)If Not Maildb.IsOpen = True

19、 ThenCall Maildb.OpenEnd IfCreate the mail documentSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE(“Form“, “Memo“)Set the recipientCall MailDoc.REPLACEITEMVALUE(“SendTo“, ““)Set subjectCall MailDoc.REPLACEITEMVALUE(“Subject“, “Subject Text“)Create and set the Body contentSet Body =

20、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)Example to save the message (optional)MailDoc.SAVEMESSAGEONSEND = TrueSend the documentGets the mail to appe

21、ar in the Sent items folderCall MailDoc.REPLACEITEMVALUE(“PostedDate“, Now()Call MailDoc.SEND(False)Clean UpSet Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingEnd Sub结果，首先会要求输入密码，这样的话，不用打开 lotus notes 就可以发送邮件了如果不想每次都手动的输入密码的话，可以如下设置，call session.initialize(“密码”)Sub abb()

22、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:notesdatamail3tonyhf.nsf“)If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd IfSet MailDoc = Mai

23、ldb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE(“Form“, “Memo“)Call MailDoc.REPLACEITEMVALUE(“SendTo“, ““)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, “, A

24、ctiveWorkbook.FullName)MailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPLACEITEMVALUE(“PostedDate“, Now()Call MailDoc.SEND(False)Set Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingMsgBox “发送成功!“End Sub结果如下，12, 如果想要设置发送邮件时候的抄送等信息，设置如下，结果，如果想要发送给多个收件人，则设置如下，结果，13, 如果想要在发出的邮

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

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

27、anotesDim aDataBaseDim aviewDim itotalDim adocumentDim wsDim notesdocSet ws = CreateObject(“Notes.NotesUIWorkspace“)Set anotes = CreateObject(“Notes.NotesSession“)Set aDataBase = anotes.GETDATABASE(“, “D:notesdatamail3tonyhf.nsf“)Set notesdoc = aDataBase.CREATEDOCUMENTSet uidoc = ws.EDITDOCUMENT(Tru

28、e, 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 To x)For

29、y = 1 To xarr(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.GETDATABASE

30、(“, “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.CREATERICHTEXT

31、ITEM(“Body“)Call 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 Sub结果，