1、用VBA操纵Lotus notes发邮件287,用lotusnotes发送邮件,第一种方法,SubSendWithLotus()DimnoSessionAsObject,noDatabaseAsObjectDimnoDocumentAsObject,noAttachmentAsObjectDimFileSelfAsStringDimiAsLongConstEMBED_ATTACHMENT=1454ConststSubjectAsString=ForLotusVBAProgrammingTestonlyDimstMsgAsStringFileSelf=ThisWorkbook.Path+This
2、Workbook.NamestMsg=Bst&Rgds&vbCrLf&_Application.UserName&vbCrLf&_vbCrLf&_*&vbCrLf&_(Thissanautomatede-mailnotification,pleasedonotreplythismessage.)DimvaRecipientAsVariantInsertLotusNotesCOMobject.SetnoSession=CreateObject(Notes.NotesSession)SetnoDatabase=noSession.GETDATABASE(,D:notesdatamail3tonyh
3、f.nsf)IfnoDatabase.IsOpen=FalseThennoDatabase.OPENMAILSetnoDocument=noDatabase.CREATEDOCUMENTSetnoAttachment=noDocument.CREATERICHTEXTITEM(Body)noAttachment.EMBEDOBJECTEMBED_ATTACHMENT,FileSelfWithnoDocument.Form=Memo.SendTo=vaRecipient.Subject=stSubject.Body=stMsg.SAVEMESSAGEONSEND=True.PostedDate=
4、Now().SEND0,vaRecipientEndWithSetnoDocument=NothingSetnoDatabase=NothingSetnoSession=NothingAppActivateMicrosoftExcelMsgBoxThisfilebesent,vbInformationEndSub第二种方法SubSendWithLotus()DimnoSessionAsObject,noDatabaseAsObjectDimnoDocumentAsObject,noAttachmentAsObjectDimvaFilesAsVariantDimiAsLongConstEMBED
5、_ATTACHMENT=1454ConststSubjectAsString=ForLotusVBAProgrammingTestonlyConststMsgAsString=Thisfileisforyou!justforreference&vbCrLf&IamStanleyPanDimvaRecipientAsVariantvaFiles=Application.GetOpenFilename(FileFilter:=ExcelFiler(*.xls),*.xls,Title:=AttachfilesforoutgoingE_Mail,MultiSelect:=True)IfNotIsAr
6、ray(vaFiles)ThenExitSubInsertLotusNotesCOMobject.SetnoSession=CreateObject(Notes.NotesSession)SetnoDatabase=noSession.GETDATABASE(,D:notesdatamail3tonyhf.nsf)IfnoDatabase.IsOpen=FalseThennoDatabase.OPENMAILSetnoDocument=noDatabase.CREATEDOCUMENTSetnoAttachment=noDocument.CREATERICHTEXTITEM(Body)With
7、noAttachmentFori=1ToUBound(vaFiles).EMBEDOBJECTEMBED_ATTACHMENT,vaFiles(i)NextiEndWithWithnoDocument.Form=Memo.SendTo=vaRecipient.Subject=stSubject.Body=stMsg.SAVEMESSAGEONSEND=True.PostedDate=Now().SEND0,vaRecipientEndWithSetnoDocument=NothingSetnoDatabase=NothingSetnoSession=NothingAppActivateMicr
8、osoftExcelMsgBoxThisfileissendOK,vbInformationEndSub1,返回当前数据库的信息,a,返回当前数据库的名称,结果,b,返回当前数据库的文件名,c,返回当前数据库的文件路径,2,发送邮件的一些设置,Subaaaaaa()DimnoAsObjectDimdbAsObjectDimdocAsObjectDimfieldsAsObjectDimnofieldsAsObjectDimattAsVariantatt=Application.GetOpenFilename(FileFilter:=ExcelFiler(*.xls),*.xls,_Title:=
9、AttachfilesforoutgoingE_Mail,MultiSelect:=True)添加附件Setno=CreateObject(notes.notessession)建立和邮件的连接Setdb=no.CURRENTDATABASE建立和邮件数据库的连接Setdoc=db.CREATEDOCUMENT创建一个新的邮件Setfields=doc.CREATERICHTEXTITEM(body)设置新邮件的正文(附件)对象Withfields设置邮件的正文和附件.APPENDTEXTthise-mailisgeneratedbyanautomatedprocessjustforatest
10、.ADDNEWLINE1增加第一行.APPENDTEXTpleasedonotreply.ADDNEWLINE2增加第二行Fori=1ToUBound(att)添加附件.EMBEDOBJECT1454,att(i)NextiEndWithWithdoc设置新邮件的除正文和附件外的其他信息.form=Memo新邮件.Subject=thismailisjustfortesting主题.SAVEMESSAGEONSEND=True是否保存发送的邮件到发件箱.postdate=DateAdd(d,1,Date)发送日期等于当天.SEND0发送EndWithMsgBoxsuccessfullysent
11、outthemail!Setno=Nothing释放内存Setdb=NothingSetdoc=NothingSetfields=NothingEndSub在添加附件的时候,如果只是想将当前的活动工作薄作为附件的话,如下,注意一下,如果是1452的话,效果如下,会出现一个提示,询问文档包含外部对象链接,是否要更新链接,如果确定的话,效果如下,会将EXCEL文件中的内容以图片形式打开,同时文件是只读格式的,如果是1453,效果如下,不会有提示,但是文件为只读,如果为1454,则为正常的EXCEL文件格式,3,提取邮件的一些信息,以上的发件人,发送时间,主题等信息还可以如下表示,运行结果,4,指定
12、是在收件箱,发件箱或其他自定义的文件夹,a,收件箱等邮箱本身就存在的,b,如果是自己创建的文件夹及子文件夹,比如在我的邮箱中有自定义的文件夹,folders,如果要想获取其下面的子文件夹之一的相关资料,则应如下书写,4,用上面的方法提取出来的发件人是有公司名称的,anotes.CREATENAME(adocument.GETITEMVALUE(from)(0).ABBREVIATED如果不使用abbreviated,则结果为,如果想要输出的发件人只有名字,没有公司名的话,可以做如下更改,结果为,排版之后的效果如下所示,5,如果想要将附件保存到指定的文件夹的话,以上代码是将发件箱中的附件保存到D
13、盘的新建文件夹,以下将发件箱改成自定义的文件夹,”HRinformation”6,用以下方法也可以获得附件的名称,结果,也可以将oemb.source改成oemb.name,结果一样,结果,以上代码是获取发件箱中的第一个邮件的附件名称,7,设置发送邮件时的邮件正文,以上的代码中,其实withfields和withdoc都是设置邮件的正文,withfields,是设置邮件的正文和附件信息,withdoc,是设置邮件的发送人,是否保存到发件箱等一些其他的信息,8,在发送邮件的时候,要注意body的问题,a,如果自始至终都使用body来添加附件和正文的话,则添加的正文就不会出现,就只有附件,发送后的
14、结果,注意,以上发送出去的邮件是没有正文的,只有附件,就是说以上的代码用withdoc添加的body正文没有添加成功,如果想要有正文的话,有两个办法,第一,将第一个括号里面的body改成和第三个红框里面的body不同的字符,结果,注意,这样更改后的结果就是,发送的邮件的正文文本和附件之间有一条线分隔,第二种方法,就是用appendtext方法添加空行的方法,以上的代码就是通过添加空行,添加文本的方法来添加正文文本部分,结果,9,枚举所有folder的名称,结果,以上代码是返回所有的文件夹,以下的代码返回的是非文件夹,结果,10,如果想要将发件人的名称改成其他的名称,比如groupsender,
15、可以做如下设置,请注意以上代码中的红色框框部分,加上doc.principal=“groupsender”,收到的邮件的发件人就会显示groupsender,结果,11,如果在没有打开邮箱的情况下想发送邮件,可以设置如下Subabb()DimMaildbAsObjectDimMailDocAsObjectDimBodyAsObjectDimSessionAsObjectStartasessiontonotesSetSession=CreateObject(Lotus.NotesSession)ThislinepromptsforpasswordofcurrentIDnotedinNotes.I
16、NICallSession.InitializeorusebelowtosupplypasswordofthecurrentIDCallSession.Initialize()OpenthemaildatabaseinnotesSetMaildb=Session.GETDATABASE(,D:notesdatamail3tonyhf.nsf)IfNotMaildb.IsOpen=TrueThenCallMaildb.OpenEndIfCreatethemaildocumentSetMailDoc=Maildb.CREATEDOCUMENTCallMailDoc.REPLACEITEMVALUE
17、(Form,Memo)SettherecipientSetsubjectCallMailDoc.REPLACEITEMVALUE(Subject,SubjectText)CreateandsettheBodycontentSetBody=MailDoc.CREATERICHTEXTITEM(Body)CallBody.APPENDTEXT(Bodytexthere)Exampletocreateanattachment(optional)CallBody.ADDNEWLINE(2)CallBody.EMBEDOBJECT(1454,ActiveWorkbook.FullName)Example
18、tosavethemessage(optional)MailDoc.SAVEMESSAGEONSEND=TrueSendthedocumentGetsthemailtoappearintheSentitemsfolderCallMailDoc.REPLACEITEMVALUE(PostedDate,Now()CallMailDoc.SEND(False)CleanUpSetMaildb=NothingSetMailDoc=NothingSetBody=NothingSetSession=NothingEndSub结果,首先会要求输入密码,这样的话,不用打开lotusnotes就可以发送邮件了如
19、果不想每次都手动的输入密码的话,可以如下设置,callsession.initialize(“密码”)Subabb()DimMaildbAsObjectDimMailDocAsObjectDimBodyAsObjectDimSessionAsObjectSetSession=CreateObject(lotus.NotesSession)CallSession.Initialize(ilove1237)SetMaildb=Session.GETDATABASE(,D:notesdatamail3tonyhf.nsf)IfNotMaildb.IsOpen=TrueThenCallMaildb.O
20、penEndIfSetMailDoc=Maildb.CREATEDOCUMENTCallMailDoc.REPLACEITEMVALUE(Form,Memo)CallMailDoc.REPLACEITEMVALUE(Subject,SubjectText)SetBody=MailDoc.CREATERICHTEXTITEM(Body)CallBody.APPENDTEXT(Bodytexthere)CallBody.ADDNEWLINE(2)CallBody.EMBEDOBJECT(1454,ActiveWorkbook.FullName)MailDoc.SAVEMESSAGEONSEND=T
21、rueCallMailDoc.REPLACEITEMVALUE(PostedDate,Now()CallMailDoc.SEND(False)SetMaildb=NothingSetMailDoc=NothingSetBody=NothingSetSession=NothingMsgBox发送成功!EndSub结果如下,12,如果想要设置发送邮件时候的抄送等信息,设置如下,结果,如果想要发送给多个收件人,则设置如下,结果,13,如果想要在发出的邮件中添加当前的签名的话,可以设置如下,其中,如果当前的签名不是文本,而是图片的话,这句代码就会返回作为当前签名的图片的名称和存放地址,说明我当前的签名
22、图片是存放在D盘的photo1文件夹中的,图片名称为邮件,如下,最后发送出去的结果如下所示,可以看到,签名在此时就是图片的地址,因为其不是一段文本,所以才会这样,而如果签名为文本的时候,效果如下,以上就是上面这句代码返回的文本签名的内容,发送出去的邮件如下所示,14,如果想要进行正文文本的排版的话(即分段隔行等),设置如下,注意几个地方,一个是addnewline,在一句话完了之后的第一个vbnewline是起换行的作用,而第二个vbnewline才是新添加一个空行,二个是在这种情况下,如果通过doc的body属性添加正文文本的话,则在声明fields的时候,不能也使用body,要使用不同于b
23、ody的名字,效果如下,要达到同样的效果,还有一种方法,请注意,上面的代码中,有addnewline,在其后面的数字表示添加的行数,一般如果是隔行的话,则要添加两行,一行起换行作用,一行为添加的空行,最终效果如下,15,返回邮件服务器的名称,结果,结果,16,返回notes的用户名,1,结果,2,结果,17,打开一个新邮件,并且将光标移到发件人,抄送人,或正文等处Subaaa()DimanotesDimaDataBaseDimaviewDimitotalDimadocumentDimwsDimnotesdocSetws=CreateObject(Notes.NotesUIWorkspace)S
24、etanotes=CreateObject(Notes.NotesSession)SetaDataBase=anotes.GETDATABASE(,D:notesdatamail3tonyhf.nsf)Setnotesdoc=aDataBase.CREATEDOCUMENTSetuidoc=ws.EDITDOCUMENT(True,notesdoc)Calluidoc.GOTOFIELD(Body)EndSub执行完以上的代码之后,光标会移到邮件的正文,处于编辑状态,如果将body换成subject的话,光标就会处于收件人处,18,如何根据工作表中多个邮箱地址发邮件,Sub发送邮件()DimM
25、aildbAsObjectDimMailDocAsObjectDimBodyAsObjectDimSessionAsObjectDimattDimarrx=Sheets(1).Range(a65536).End(xlUp).RowReDimarr(1Tox)Fory=1Toxarr(y)=Sheets(1).Cells(y,1)Nextyatt=Application.GetOpenFilename(FileFilter:=ExcelFiler(*.xls),*.xls,_Title:=AttachfilesforoutgoingE_Mail,MultiSelect:=True)添加附件Set
26、Session=CreateObject(lotus.NotesSession)Session.Initialize(ilove1237)SetMaildb=Session.GETDATABASE(,D:notesdatamail3tonyhf.nsf)IfNotMaildb.IsOpen=TrueThenCallMaildb.OpenEndIfSetMailDoc=Maildb.CREATEDOCUMENTCallMailDoc.REPLACEITEMVALUE(Form,Memo)CallMailDoc.REPLACEITEMVALUE(SendTo,arr)CallMailDoc.REP
27、LACEITEMVALUE(Subject,SubjectText)SetBody=MailDoc.CREATERICHTEXTITEM(Body)CallBody.APPENDTEXT(Bodytexthere)CallBody.ADDNEWLINE(2)Fori=1ToUBound(att)CallBody.EMBEDOBJECT(1454,att(i)NextiMailDoc.SAVEMESSAGEONSEND=TrueCallMailDoc.REPLACEITEMVALUE(PostedDate,Now()CallMailDoc.SEND(False)SetMaildb=Nothing
28、SetMailDoc=NothingSetBody=NothingSetSession=NothingMsgBox发送成功!EndSub结果,19,如何用VBS发邮件,Dimmydocu,os,myBodySetos=CreateObject(Notes.NotesSession)SetmyBody=myDocu.CREATERICHTEXTITEM(Body)withmybody.appendtextthise-mailisgeneratedbyautomatedprocess,youdontneedtoreply.addnewline2.embedobject1454,C:Document
29、sandSettingstony桌面overheadgroup.xlsendwithwithmydocu.CopyTo=.Subject=thisisfortest.SEND0endwithmsgbox发送邮件成功!,vbinformation,提示SetmyDocu=NothingSetmyBody=NothingSetos=Nothing发送方法,双击VBS图标即可,20,如何将excel的部分内容作为richtext格式粘贴在邮件中,Subaa()DimnoAsObjectDimdbAsObjectDimclipboardAsDataObjectDimdocAsObjectDimfieldAsObjectSetno=CreateObject(notes.notessession)建立和邮件的连接Setdb=no.CurrentDatabaseSetdoc=db.CreateDocumentSetfield=doc.CreateRichTextItem(body)Selection.CopySetclipboard=NewDataObjectclipboard.GetFromClipboardWithfield.App
copyright@ 2008-2023 冰点文库 网站版权所有
经营许可证编号:鄂ICP备19020893号-2