用VBA操縱Lotus_notes發(fā)郵件

1、287 , 用lotus notes發(fā)送郵件，第一種方法，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 StringF

2、ileSelf = ThisWorkbook.Path + "" + ThisWorkbook.NamestMsg = "Bst & Rgds" & vbCrLf & _ Application.UserName & vbCrLf & _ vbCrLf & _ "*" & vbCrLf & _ "(This's an automated e-mail notification, please do not reply this message.)&quo

3、t;Dim vaRecipient As Variant vaRecipient = VBA.Array("huangfeng8211") 'Insert Lotus Notes COM object. Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "D:notesdatamail3tonyhf.nsf") If noDatabase.IsOpen = False T

4、hen noDatabase.OPENMAIL Set noDocument = noDatabase.CREATEDOCUMENT Set noAttachment = noDocument.CREATERICHTEXTITEM("Body") noAttachment.EMBEDOBJECT EMBED_ATTACHMENT, "", FileSelf With noDocument .Form = "Memo" .SendTo = vaRecipient .Subject = stSubject .Body = stMsg .S

5、AVEMESSAGEONSEND = 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", vbInformationEnd Sub第二種方法Sub SendWithLotus()Dim noSession As Object, noDat

6、abase 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 file is for you! just for reference" & vbCrLf & &q

7、uot;I am StanleyPan"Dim vaRecipient As Variant vaRecipient = VBA.Array("stanleypan2000", "stanley.panIsolaA") vaFiles = Application.GetOpenFilename(FileFilter:="Excel Filer (*.xls),*.xls", Title:="Attach files for outgoing E_Mail", MultiSelect:=True) If N

8、ot IsArray(vaFiles) Then Exit Sub 'Insert Lotus Notes COM object. Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "D:notesdatamail3tonyhf.nsf") If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Set noDocument = noDat

9、abase.CREATEDOCUMENT Set noAttachment = noDocument.CREATERICHTEXTITEM("Body") With noAttachment For i = 1 To UBound(vaFiles) .EMBEDOBJECT EMBED_ATTACHMENT, "", vaFiles(i) Next i End With With noDocument .Form = "Memo" .SendTo = vaRecipient .Subject = stSubject .Body = s

10、tMsg .SAVEMESSAGEONSEND = True .PostedDate = Now() .SEND 0, vaRecipient End With Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing AppActivate "Microsoft Excel" MsgBox "This file is send OK", vbInformationEnd Sub1, 返回當前數(shù)據(jù)庫的信息，a, 返回當前數(shù)據(jù)庫的名稱，結果，b, 返回當前數(shù)據(jù)庫的文件

11、名，c, 返回當前數(shù)據(jù)庫的文件路徑，2，發(fā)送郵件的一些設置，Sub aaaaaa()Dim no As ObjectDim db As ObjectDim doc As ObjectDim fields As ObjectDim nofields As ObjectDim att As Variantatt = Application.GetOpenFilename(FileFilter:="Excel Filer (*.xls),*.xls", _Title:="Attach files for outgoing E_Mail", MultiSelec

12、t:=True) '添加附件Set no = CreateObject("notes.notessession") '建立和郵件的連接Set db = no.CURRENTDATABASE '建立和郵件數(shù)據(jù)庫的連接Set doc = db.CREATEDOCUMENT '創(chuàng)建一個新的郵件Set fields = doc.CREATERICHTEXTITEM("body") '設置新郵件的正文（附件）對象 With fields '設置郵件的正文和附件 .APPENDTEXT " this e-ma

13、il 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 i End WithWith doc '設置新郵件的除正文和附件外的其他信息 .form = "Memo&

14、quot; '新郵件 .sendto = VBA.Array("huangfeng8211", "tonyhf") '發(fā)送給 .Subject = "this mail is just for testing" '主題 .SAVEMESSAGEONSEND = True '是否保存發(fā)送的郵件到發(fā)件箱 .postdate = DateAdd("d", 1, Date) '發(fā)送日期等于當天 .SEND 0 '發(fā)送 End WithMsgBox "successf

15、ully sent out the mail!"Set no = Nothing '釋放內存Set db = NothingSet doc = NothingSet fields = NothingEnd Sub在添加附件的時候，如果只是想將當前的活動工作薄作為附件的話，如下，注意一下, 如果是1452的話, 效果如下, 會出現(xiàn)一個提示, 詢問文檔包含外部對象鏈接, 是否要更新鏈接, 如果確定的話, 效果如下, 會將EXCEL文件中的內容以圖片形式打開, 同時文件是只讀格式的, 如果是1453, 效果如下, 不會有提示, 但是文件為只讀, 如果為1454, 則為正常的EXCE

16、L文件格式, 3, 提取郵件的一些信息，以上的發(fā)件人，發(fā)送時間，主題等信息還可以如下表示，運行結果，4，指定是在收件箱，發(fā)件箱或其他自定義的文件夾，a, 收件箱等郵箱本身就存在的，b, 如果是自己創(chuàng)建的文件夾及子文件夾，比如在我的郵箱中有自定義的文件夾，folders, 如果要想獲取其下面的子文件夾之一的相關資料，則應如下書寫，4, 用上面的方法提取出來的發(fā)件人是有公司名稱的，anotes.CREATENAME(adocument.GETITEMVALUE("from")(0).ABBREVIATED如果不使用abbreviated, 則結果為，如果想要輸出的發(fā)件人只有名字

17、，沒有公司名的話，可以做如下更改，結果為，排版之后的效果如下所示，5, 如果想要將附件保存到指定的文件夾的話，以上代碼是將發(fā)件箱中的附件保存到D盤的新建文件夾，以下將發(fā)件箱改成自定義的文件夾，”HR information”6, 用以下方法也可以獲得附件的名稱，結果，也可以將oemb.source改成, 結果一樣，結果，以上代碼是獲取發(fā)件箱中的第一個郵件的附件名稱，7, 設置發(fā)送郵件時的郵件正文，以上的代碼中，其實with fields和with doc都是設置郵件的正文，with fields, 是設置郵件的正文和附件信息，with doc, 是設置郵件的發(fā)送人，是否保存到

18、發(fā)件箱等一些其他的信息，8, 在發(fā)送郵件的時候，要注意body的問題，a, 如果自始至終都使用body來添加附件和正文的話，則添加的正文就不會出現(xiàn)，就只有附件，發(fā)送后的結果，注意，以上發(fā)送出去的郵件是沒有正文的，只有附件，就是說以上的代碼用with doc添加的body正文沒有添加成功，如果想要有正文的話，有兩個辦法，第一， 將第一個括號里面的body改成和第三個紅框里面的body不同的字符，結果，注意，這樣更改后的結果就是，發(fā)送的郵件的正文文本和附件之間有一條線分隔，第二種方法， 就是用appendtext方法添加空行的方法，以上的代碼就是通過添加空行，添加文本的方法來添加正文文本部分，結果

19、，9, 枚舉所有folder的名稱，結果，以上代碼是返回所有的文件夾，以下的代碼返回的是非文件夾，結果，10, 如果想要將發(fā)件人的名稱改成其他的名稱，比如group sender, 可以做如下設置，請注意以上代碼中的紅色框框部分，加上doc.principal = “group sender”， 收到的郵件的發(fā)件人就會顯示group sender, 結果，11, 如果在沒有打開郵箱的情況下想發(fā)送郵件，可以設置如下Sub abb()Dim Maildb As ObjectDim MailDoc As ObjectDim Body As ObjectDim Session As Object

20、9;Start a session to notesSet Session = CreateObject("Lotus.NotesSession")'This line prompts for password of current ID noted in Notes.INICall Session.Initialize'or use below to supply password of the current ID'Call Session.Initialize("")'Open the mail database i

21、n notesSet Maildb = Session.GETDATABASE("", "D:notesdatamail3tonyhf.nsf")If Not Maildb.IsOpen = True ThenCall Maildb.OpenEnd If'Create the mail documentSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE("Form", "Memo")'Set the recipientCa

22、ll MailDoc.REPLACEITEMVALUE("SendTo", "huangfeng8211")'Set subjectCall MailDoc.REPLACEITEMVALUE("Subject", "Subject Text")'Create and set the Body contentSet Body = MailDoc.CREATERICHTEXTITEM("Body")Call Body.APPENDTEXT("Body text here&q

23、uot;)'Example to create an attachment (optional)Call Body.ADDNEWLINE(2)Call Body.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName)'Example to save the message (optional)MailDoc.SAVEMESSAGEONSEND = True'Send the document'Gets the mail to appear in the Sent items folderCall Mail

24、Doc.REPLACEITEMVALUE("PostedDate", Now()Call MailDoc.SEND(False)'Clean UpSet Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingEnd Sub結果，首先會要求輸入密碼，這樣的話，不用打開lotus notes就可以發(fā)送郵件了如果不想每次都手動的輸入密碼的話，可以如下設置，call session.initialize(“密碼”)Sub abb()Dim Maildb As ObjectDim

25、 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 I

26、fSet MailDoc = Maildb.CREATEDOCUMENTCall MailDoc.REPLACEITEMVALUE("Form", "Memo")Call MailDoc.REPLACEITEMVALUE("SendTo", "huangfeng8211")Call MailDoc.REPLACEITEMVALUE("Subject", "Subject Text")Set Body = MailDoc.CREATERICHTEXTITEM("Bod

27、y")Call Body.APPENDTEXT("Body text here")Call Body.ADDNEWLINE(2)Call Body.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName)MailDoc.SAVEMESSAGEONSEND = TrueCall MailDoc.REPLACEITEMVALUE("PostedDate", Now()Call MailDoc.SEND(False)Set Maildb = NothingSet MailDoc = Nothin

28、gSet Body = NothingSet Session = NothingMsgBox "發(fā)送成功!"End Sub結果如下，12, 如果想要設置發(fā)送郵件時候的抄送等信息，設置如下，結果，如果想要發(fā)送給多個收件人，則設置如下，結果，13, 如果想要在發(fā)出的郵件中添加當前的簽名的話，可以設置如下，其中，如果當前的簽名不是文本，而是圖片的話，這句代碼就會返回作為當前簽名的圖片的名稱和存放地址，說明我當前的簽名圖片是存放在D盤的photo1文件夾中的，圖片名稱為郵件，如下，最后發(fā)送出去的結果如下所示，可以看到，簽名在此時就是圖片的地址，因為其不是一段文本，所以才會這樣，而如

29、果簽名為文本的時候，效果如下，以上就是上面這句代碼返回的文本簽名的內容，發(fā)送出去的郵件如下所示，14, 如果想要進行正文文本的排版的話（即分段隔行等），設置如下，注意幾個地方，一個是addnewline, 在一句話完了之后的第一個vbnewline是起換行的作用，而第二個vbnewline才是新添加一個空行，二個是在這種情況下，如果通過doc的body屬性添加正文文本的話，則在聲明fields的時候，不能也使用body, 要使用不同于body的名字，效果如下，要達到同樣的效果，還有一種方法，請注意，上面的代碼中，有addnewline，在其后面的數(shù)字表示添加的行數(shù)，一般如果是隔行的話，則要添加

30、兩行，一行起換行作用，一行為添加的空行，最終效果如下，15, 返回郵件服務器的名稱，結果，結果，16, 返回notes的用戶名，1, 結果，2, 結果，17, 打開一個新郵件，并且將光標移到發(fā)件人，抄送人，或正文等處Sub aaa() Dim anotes Dim aDataBase Dim aview Dim itotal Dim adocument Dim ws Dim notesdoc Set ws = CreateObject("Notes.NotesUIWorkspace") Set anotes = CreateObject("Notes.NotesS

31、ession") Set aDataBase = anotes.GETDATABASE("", "D:notesdatamail3tonyhf.nsf") Set notesdoc = aDataBase.CREATEDOCUMENT Set uidoc = ws.EDITDOCUMENT(True, notesdoc) Call uidoc.GOTOFIELD("Body")End Sub執(zhí)行完以上的代碼之后，光標會移到郵件的正文，處于編輯狀態(tài)，如果將body換成subject的話，光標就會處于收件人處，18, 如何根據(jù)工

32、作表中多個郵箱地址發(fā)郵件，Sub 發(fā)送郵件()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 y = 1 To x arr(y) = Sheets(1).Cells(y, 1) Next yatt = Application.GetOpenFilename(FileFilter:="Excel Fil

33、er (*.xls),*.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 M

34、aildb.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.CREAT

35、ERICHTEXTITEM("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

36、 Maildb = NothingSet MailDoc = NothingSet Body = NothingSet Session = NothingMsgBox "發(fā)送成功!"End Sub結果，19, 如何用VBS發(fā)郵件，Dim mydocu , os , myBodySet os = CreateObject("Notes.NotesSession")Set myDocu = os.CURRENTDATABASE.CREATEDOCUMENTSet myBody = myDocu.CREATERICHTEXTITEM("Body&qu

37、ot;)with mybody .appendtext "this e-mail is generated by automated process, you don't need to reply" .addnewline 2 .embedobject 1454,"","C:Documents and Settingstony桌面overhead group.xls"end with with mydocu .SendTo = "tonyhf" .CopyTo = "" .Subjec

38、t = "this is for test" .SEND 0end with msgbox "發(fā)送郵件成功!",vbinformation, "提示"Set myDocu = NothingSet myBody = NothingSet os = Nothing發(fā)送方法，雙擊VBS圖標即可，20, 如何將excel的部分內容作為richtext格式粘貼在郵件中, Sub aa()Dim no As ObjectDim db As ObjectDim clipboard As DataObjectDim doc As ObjectDim

39、 field As ObjectSet no = CreateObject("notes.notessession") '建立和郵件的連接Set db = no.CurrentDatabaseSet doc = db.CreateDocumentSet field = doc.CreateRichTextItem("body")Selection.CopySet clipboard = New DataObjectclipboard.GetFromClipboardWith field .AppendText "此郵件為系統(tǒng)自動發(fā)送，請

40、不要回復，僅作為測試使用！" .AddNewLine 2 .AppendText clipboard.GetText(1) End WithWith doc .form = "Memo" .sendto = "tonyhf" .Subject = "自動郵件" .SaveMessageOnSend = True .postdate = Now() .Send 0 End WithSelection(1).SelectApplication.CutCopyMode = FalseEnd Sub發(fā)送的效果如下圖, 21, 在發(fā)送

41、附件的時候要注意的問題, 以下的代碼的目的是發(fā)送帶附件的郵件, 但是有個問題值得注意: 下面的正文部分和收件人信息部分不能置換位置, 如果將收件人信息放在正文上方, 則發(fā)出的郵件正文部分為空白, 22, 如何避免在用循環(huán)發(fā)送多個郵件的時候, 出現(xiàn)所有的附件都集中在一個郵件中的情況, 如果以上面的代碼發(fā)送郵件的話, 就會出現(xiàn)所有的郵件都集中在一個郵件中的情況, 效果如下, 原因為: VBA和Lotus notes執(zhí)行不同步造成的, 因為當lotus notes還沒有處理完前一個郵件的時候, VBA已經執(zhí)行到下一個循環(huán)了, 解決辦法: 執(zhí)行完一個循環(huán), 就將設置正文及標題信息的doc對象設置成no

42、thing, 然后到下一個循環(huán)的時候, 再用set函數(shù)創(chuàng)建, 發(fā)送后的效果如下所示:23, notesview的type值, ACTIONCD (16) means saved action CD records; non-Computable; canonical form. ASSISTANTINFO (17) means saved assistant information; non-Computable; canonical form. ATTACHMENT (1084) means file attachment. AUTHORS (1076) means authors. COL

43、LATION (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 text.

44、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.

45、 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. UNAVAI

46、LABLE (512) means the item type isn't available. UNKNOWN (0) means the item type isn't known. USERDATA (14) means user data. USERID (1792) means user ID name. VIEWMAPDATA (18) means saved ViewMap dataset; non-Computable; canonical form. VIEWMAPLAYOUT (19) means saved ViewMap layout; non-Comp

47、utable; canonical form.以下代碼返回inbox中的最后一封郵件的body的類型,Sub Click() Dim session Dim db Dim view Dim doc Dim ent Dim fil Dim ite Dim doc1 Dim emb fil = 0 ite = 0 emb = 0 Set session = CreateObject("notes.notessession") Set db = session.GETDATABASE("", "d:notesdatamail3tonyhf.nsf&q

48、uot;) Set view = db.GetView("($inbox)") Set doc = view.getlastdocument Set doc1 = doc.getfirstitem("body") MsgBox doc1.TypeEnd sub結果24, notesdocument 和notesrichtextitem 在有附件時候的區(qū)別, 結果也就是說, notesdocument 是支持hasembedded屬性的，而notesrichtextitem 是不支持的, 同時, noteitem 也沒有這個屬性, 因為richtextit

49、em是item的一種子類型, 注意以下的語句,想通過以上的代碼首先判斷最后一封郵件中是否有附件，如果有，則依次返回其名稱，結果，原因如下，Unlike the EmbeddedObjects property in NotesRichTextItem, 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.

50、It also includes objects in the document that were originally embedded in the document's form. Such objects must have been activated, modified, and re-saved in order to be returned by this property (otherwise they remain a part of the form, not the document).所以要想達到以上效果，要通過notesrichtextitem 對象, 即

51、上面的代碼中定義的doc1, 但是doc1沒有hasembedded這個屬性可以判斷是否包括附件，但是要判斷是否包含附件，可以通過notesdocument 對象的的hasembedded屬性，結果，25, item 中的element, 使用getfirstelement, 如果使用findfirstelement, 則有以下type,26, 返回郵件正文(不包括簽名), - 包括發(fā)件人，時間，收件人，抄送，主題，Sub Click() Dim session Dim db Dim view Dim doc Dim ent Dim fil Dim ite Dim doc1 Dim emb S

52、et session = CreateObject("notes.notessession") Set db = session.GETDATABASE("", "d:notesdatamail3tonyhf.nsf") Set view = db.GetView("($inbox)") Set doc = view.getlastdocument Set doc1 = doc.getfirstitem("body") Set ent = doc1.createnavigator If ent.

53、findfirstelement(4) Then Do Set emb = doc1.createrange Call emb.setbegin(ent) MsgBox emb.textparagraph Loop Until Not ent.findnextelement(4) End If End Sub結果，26, 關閉當前打開的郵件窗口, Sub a() Dim workspace Dim uidoc Dim uidoc1 Set workspace = CreateObject("notes.notesuiworkspace") Set uidoc = works

54、pace.Currentdocument Call uidoc.Close End Sub結果，27, 如何返回當前打開郵件的相關信息, 返回正文部分, 發(fā)件人收件人抄送秘密抄送正文另外一種返回此上信息的方法是通過notesdocument對象的getitemvalue方法，返回正文，和通過notesuidocument對象的fieldgettext方法相比, 優(yōu)點在于: 返回的正文的文本格式沒有變化, 28, 如何設置文字的格式- CREATERICHTEXTSTYLESub aaaaaa()Dim no As ObjectDim db As ObjectDim doc As ObjectD

55、im fields As ObjectDim nofields As ObjectDim att As VariantDim style As ObjectSet no = CreateObject("notes.notessession") '建立和郵件的連接Set db = no.CURRENTDATABASE '建立和郵件數(shù)據(jù)庫的連接Set doc = db.CREATEDOCUMENT '創(chuàng)建一個新的郵件Set fields = doc.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 =