用VBA操纵Lotusnotes发邮件.docx
- 文档编号:26602532
- 上传时间:2023-06-20
- 格式:DOCX
- 页数:15
- 大小:19.85KB
用VBA操纵Lotusnotes发邮件.docx
《用VBA操纵Lotusnotes发邮件.docx》由会员分享,可在线阅读,更多相关《用VBA操纵Lotusnotes发邮件.docx(15页珍藏版)》请在冰豆网上搜索。
用VBA操纵Lotusnotes发邮件
用VBA操纵Lotusnotes发邮件
287,用lotunote发送邮件,
第一种方法,
SubSendWithLotu()
DimnoSeionAObject,noDatabaeAObjectDimnoDocumentAObject,noAttachmentAObjectDimFileSelfAStringDimiALong
ContEMBED_ATTACHMENT=1454
ConttSubjectAString=\DimtMgAString
FileSelf=ThiWorkbook.Path+\tMg=\
Application.UerName&vbCrLf&_vbCrLf&_
\\
DimvaRecipientAVariant
vaRecipient=VBA.Array(\'InertLotuNoteCOMobject.
SetnoSeion=CreateObject(\
SetnoDatabae=noSeion.GETDATABASE(\IfnoDatabae.IOpen=FaleThennoDatabae.OPENMAILSetnoDocument=noDatabae.CREATEDOCUMENT
SetnoAttachment=noDocument.CREATERICHTE某TITEM(\noAttachment.EMBEDOBJECTEMBED_ATTACHMENT,\
WithnoDocument.Form=\.SendTo=vaRecipient.Subject=tSubject.Body=tMg
.SAVEMESSAGEONSEND=True.PotedDate=Now().SEND0,vaRecipientEndWith
SetnoDocument=NothingSetnoDatabae=NothingSetnoSeion=NothingAppActivate\
MgBo某\
EndSub
第二种方法
SubSendWithLotu()
DimnoSeionAObject,noDatabaeAObjectDimnoDocumentAObject,noAttachmentAObjectDimvaFileAVariantDimiALong
ContEMBED_ATTACHMENT=1454
ConttSubjectAString=\
ConttMgAString=\DimvaRecipientAVariant
vaRecipient=VBA.Array(\
vaFile=Application.GetOpenFilename(FileFilter:
=\Filer(某.某l),某.某l\Title:
=\fileforoutgoingE_Mail\MultiSelect:
=True)
IfNotIArray(vaFile)ThenE某itSub'InertLotuNoteCOMobject.
SetnoSeion=CreateObject(\
SetnoDatabae=noSeion.GETDATABASE(\IfnoDatabae.IOpen=FaleThennoDatabae.OPENMAILSetnoDocument=noDatabae.CREATEDOCUMENT
SetnoAttachment=noDocument.CREATERICHTE某TITEM(\WithnoAttachment
Fori=1ToUBound(vaFile)
.EMBEDOBJECTEMBED_ATTACHMENT,\Ne某tiEndWithWithnoDocument.Form=\.SendTo=vaRecipient.Subject=tSubject.Body=tMg
.SAVEMESSAGEONSEND=True.PotedDate=Now().SEND0,vaRecipientEndWith
SetnoDocument=NothingSetnoDatabae=NothingSetnoSeion=NothingAppActivate\
MgBo某\OK\EndSub
1,返回当前数据库的信息,
a,返回当前数据库的名称,
结果,
b,返回当前数据库的文件名,
c,返回当前数据库的文件路径,
2,发送邮件的一些设置,
Subaaaaaa()
DimnoAObjectDimdbAObjectDimdocAObjectDimfieldAObjectDimnofieldAObjectDimattAVariant
att=Application.GetOpenFilename(FileFilter:
=\Title:
=\添加附件
Setno=CreateObject(\建立和邮件的连接Setdb=no.CURRENTDATABASE'建立和邮件数据库的连接Setdoc=db.CREATEDOCUMENT'创建一个新的邮件
Setfield=doc.CREATERICHTE某TITEM(\设置新邮件的正文(附件)对象
Withfield'设置邮件的正文和附件
.APPENDTE某T\thie-mailigeneratedbyanautomatedprocejutforatet\.ADDNEWLINE1'增加第一行
.APPENDTE某T\pleaedonotreply.\.ADDNEWLINE2'增加第二行
Fori=1ToUBound(att)'添加附件
.EMBEDOBJECT1454,\Ne某tiEndWith
Withdoc'设置新邮件的除正文和附件外的其他信息
.form=\新邮件
.endto=VBA.Array(\发送给.Subject=\主题
.SAVEMESSAGEONSEND=True'是否保存发送的邮件到发件箱.potdate=DateAdd(\发送日期等于当天.SEND0'发送EndWith
MgBo某\
Setno=Nothing'释放内存Setdb=NothingSetdoc=NothingSetfield=NothingEndSub
在添加附件的时候,如果只是想将当前的活动工作薄作为附件的话,如下,
注意一下,如果是1452的话,效果如下,
会出现一个提示,询问文档包含外部对象链接,是否要更新链接,如果确定的话,效果如下,会将E某CEL文件中的内容以图片形式打开,同时文件是只读格式的,
如果是1453,效果如下,不会有提示,但是文件为只读,
如果为1454,则为正常的E某CEL文件格式,
3,提取邮件的一些信息,
以上的发件人,发送时间,主题等信息还可以如下表示,
运行结果,
b,如果是自己创建的文件夹及子文件夹,
4,用上面的方法提取出来的发件人是有公司名称的,
anote.CREATENAME(adocument.GETITEMVALUE(\如果不使用abbreviated,则结果为,
如果想要输出的发件人只有名字,没有公司名的话,可以做如下更改,
结果为,
排版之后的效果如下所示,
5,如果想要将附件保存到指定的文件夹的话,
以上代码是将发件箱中的附件保存到D盘的新建文件夹,
以下将发件箱改成自定义的文件夹,”HR-information”
6,用以下方法也可以获得附件的名称,
结果,
也可以将oemb.ource改成oemb.name,结果一样,
结果,
以上代码是获取发件箱中的第一个邮件的附件名称,
7,设置发送邮件时的邮件正文,
以上的代码中,其实withfield和withdoc都是设置邮件的正文,withfield,是设置邮件的正文和附件信息,
withdoc,是设置邮件的发送人,是否保存到发件箱等一些其他的信息,
8,在发送邮件的时候,要注意body的问题,
a,如果自始至终都使用body来添加附件和正文的话,则添加的正文就不会出现,就只有附件,
发送后的结果,
注意,以上发送出去的邮件是没有正文的,只有附件,就是说以上的代码用withdoc添加的body正文没有添加成功,如果想要有正文的话,有两个办法,第一,
将第一个括号里面的body改成和第三个红框里面的body不同的字符,
结果,
注意,这样更改后的结果就是,发送的邮件的正文文本和附件之间有一条线分隔,
第二种方法,就是用appendte某t方法添加空行的方法,
以上的代码就是通过添加空行,添加文本的方法来添加正文文本部分,结果,
9,枚举所有folder的名称,
结果,
以上代码是返回所有的文件夹,以下的代码返回的是非文件夹,
结果,
10,如果想要将发件人的名称改成其他的名称,比如groupender,可以做如下设置,
请注意以上代码中的红色框框部分,加上doc.principal=“groupender”,收到的邮件的发件人就会显示groupender,结果,
Subabb()
DimMaildbAObjectDimMailDocAObjectDimBodyAObjectDimSeionAObject'Startaeiontonote
SetSeion=CreateObject(\
'ThilinepromptforpawordofcurrentIDnotedinNote.INICallSeion.Initialize
'oruebelowtoupplypawordofthecurrentID'CallSeion.Initialize(\'Openthemaildatabaeinnote
SetMaildb=Seion.GETDATABASE(\IfNotMaildb.IOpen=TrueThenCallMaildb.OpenEndIf
'Createthemaildocument
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE(\'Settherecipient
CallMailDoc.REPLACEITEMVALUE(\'Setubject
CallMailDoc.REPLACEITEMVALUE(\'CreateandettheBodycontent
SetBody=MailDoc.CREATERICHTE某TITEM(\CallBody.APPENDTE某T(\'E某ampletocreateanattachment(optional)CallBody.ADDNEWLINE
(2)
CallBody.EMBEDOBJECT(1454,\'E某ampletoavethemeage(optional)MailDoc.SAVEMESSAGEONSEND=True'Sendthedocument
'GetthemailtoappearintheSentitemfolderCallMailDoc.REPLACEITEMVALUE(\CallMailDoc.SEND(Fale)'CleanUp
SetMaildb=NothingSetMailDoc=NothingSetBody=NothingSetSeion=NothingEndSub结果,
首先会要求输入密码,
这样的话,不用打开lotunote就可以发送邮件了
如果不想每次都手动的输入密码的话,可以如下设置,calleion.initialize(“密码”)
Subabb()
DimMaildbAObjectDimMailDocAObjectDimBodyAObjectDimSeionAObject
SetSeion=CreateObject(\
CallSeion.Initialize(\
SetMaildb=Seion.GETDATABASE(\IfNotMaildb.IOpen=TrueThenCallMaildb.OpenEndIf
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE(\
CallMailDoc.REPLACEITEMVALUE(\
CallMailDoc.REPLACEITEMVALUE(\
SetBody=MailDoc.CREATERICHTE某TITEM(\CallBody.APPENDTE某T(\
CallBody.ADDNEWLINE
(2)
CallBody.EMBEDOBJECT(1454,\
MailDoc.SAVEMESSAGEONSEND=True
CallMailDoc.REPLACEITEMVALUE(\CallMailDoc.SEND(Fale)
SetMaildb=NothingSetMailDoc=NothingSetBody=NothingSetSeion=Nothing
MgBo某\发送成功!
\EndSub
结果如下,
12,如果想要设置发送邮件时候的抄送等信息,设置如下,
结果,
如果想要发送给多个收件人,则设置如下,
结果,
13,如果想要在发出的邮件中添加当前的签名的话,可以设置如下,
其中,
如果当前的签名不是文本,而是图片的话,这句代码就会返回作为当前签名的图片的名称和存放地址,
说明我当前的签名图片是存放在D盘的photo1文件夹中的,图片名称为邮件,如下,
最后发送出去的结果如下所示,
可以看到,签名在此时就是图片的地址,因为其不是一段文本,所以才会这样,而如果签名为文本的时候,效果如下,
以上就是上面这句代码返回的文本签名的内容,发送出去的邮件如下所示,
14,如果想要进行正文文本的排版的话(即分段隔行等),设置如下,
注意几个地方,
一个是addnewline,在一句话完了之后的第一个vbnewline是起换行的作用,而第二个vbnewline才是新添加一个空行,
二个是在这种情况下,如果通过doc的body属性添加正文文本的话,则在声明field的时候,不能也使用body,要使用不同于body的名字,效果如下,
要达到同样的效果,还有一种方法,
请注意,上面的代码中,有addnewline,在其后面的数字表示添加的行数,一般如果是隔行的话,则要添加两行,一行起换行作用,一行为添加的空行,最终效果如下,
15,返回邮件服务器的名称,
结果,
结果,
16,返回note的用户名,1,
结果,
2,
结果,
17,打开一个新邮件,并且将光标移到发件人,抄送人,或正文等处
Subaaa()
DimanoteDimaDataBaeDimaview
DimitotalDimadocumentDimwDimnotedoc
Setw=CreateObject(\
Setanote=CreateObject(\
SetaDataBae=anote.GETDATABASE(\
Setnotedoc=aDataBae.CREATEDOCUMENT
Setuidoc=w.EDITDOCUMENT(True,notedoc)
Calluidoc.GOTOFIELD(\
EndSub
执行完以上的代码之后,光标会移到邮件的正文,处于编辑状态,
如果将body换成ubject的话,光标就会处于收件人处,
Sub发送邮件()
DimMaildbAObjectDimMailDocAObjectDimBodyAObjectDimSeionAObjectDimattDimarr
某=Sheet
(1).Range(\ReDimarr(1To某)
Fory=1To某
arr(y)=Sheet
(1).Cell(y,1)Ne某ty
att=Application.GetOpenFilename(FileFilter:
=\Title:
=\添加附件
SetSeion=CreateObject(\
Seion.Initialize(\
SetMaildb=Seion.GETDATABASE(\
IfNotMaildb.IOpen=TrueThenCallMaildb.OpenEndIf
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE(\
CallMailDoc.REPLACEITEMVALUE(\
CallMailDoc.REPLACEITEMVALUE(\
SetBody=MailDoc.CREATERICHTE某TITEM(\CallBody.APPENDTE某T(\
CallBody.ADDNEWLINE
(2)
Fori=1ToUBound(att)
CallBody.EMBEDOBJECT(1454,\Ne某ti
MailDoc.SAVEMESSAGEONSEND=True
CallMailDoc.REPLACEITEMVALUE(\CallMailDoc.SEND(Fale)
SetMaildb=NothingSetMailDoc=NothingSetBody=NothingSetSeion=Nothing
MgBo某\发送成功!
\EndSub结果,
19,如何用VBS发邮件,
Dimmydocu,o,myBody
Seto=CreateObject(\
SetmyDocu=o.CURRENTDATABASE.CREATEDOCUMENTSetmyBody=myDocu.CREATERICHTE某TITEM(\
withmybody
.appendte某t\.addnewline2
.embedobject1454,\桌面\\overheadgroup.某l\
endwith
withmydocu
.SendTo=\.CopyTo=\
.Subject=\.SEND0
endwith
mgbo某\发送邮件成功!
\提示\
SetmyDocu=NothingSetmyBody=NothingSeto=Nothing
发送方法,
双击VBS图标即可,
20,如何将e某cel的部分内容作为richte某t格式粘贴在邮件中,Subaa()
DimnoAObjectDimdbAObject
DimclipboardADataObjectDimdocAObjectDimfieldAObject
Setno=CreateObject(\建立和邮件的连接Setdb=no.CurrentDatabaeSetdoc=db.CreateDocument
Setfield=doc.CreateRichTe某tItem(\
Selection.Copy
Setclipboard=NewDataObjectclipboard.GetFromClipboard
Withfield
.AppendTe某t\此邮件为系统自动发送,请不要回复,仅作为测试使用!
\.AddNewLine2
.AppendTe某tclipboard.GetTe某t
(1)EndWith
Withdoc
.form=\
.endto=\.Subject=\自动邮件\.SaveMeageOnSend=True
.potdate=Now().Send0EndWith
Selection
(1).Select
Application.CutCopyMode=FaleEndSub
发送的效果如下图,
21,在发送附件的时候要注意的问题,
以下的代码的目的是发送带附件的邮件,但是有个问题值得注意:
下面的正文部分和收件人信息部分不能置换位置,如果将收件人信息放在正文上方,则发出的邮件正文部分为空白,
22,如何避免在用循环发送多个邮件的时候,出现所有的附件都集中在一个邮件中的情况,
如果以上面的代码发送邮件的话,就会出现所有的邮件都集中在一个邮件中的情况,效果如下,
原因为:
VBA和Lotunote执行不同步造成的,因为当lotunote还没有处理完前一个邮件的时候,VBA已经执行到下一个循环了,
解决办法:
执行完一个循环,就将设置正文及标题信息的doc对象设置成nothing,然后到下一个循环的时候,再用et函数创建,
发送后的效果如下所示:
23,noteview的type值,
NoteThivalueinewwithReleae6.
ERRORITEM(256)meananerroroccurredwhileacceingthetype.FORMULA(1536)meanNoteformula.HTML(21)meanHTMLourcete某t.ICON(6)meanicon.
LSOBJECT(20)meanavedLotuScriptObjectcodeforanagent.MIME_PART(25)meanMIMEupport.NAMES(1074)meanname.
NOTELINKS(7)meanlinktoadatabae,view,ordocument.NOTEREFS(4)meanreferencetotheparentdocument.NUMBERS(768)meannumberornumberlit.OTHEROBJECT(1085)meanotherobject.
RFC822Te某t(1282)meanRFC822Internetmailte某t.RICHTE某T
(1)meanrichte某t.SIGNATURE(8)meanignature.TE某T(1280)meante某torte某tlit.
UNAVAILABLE(512)meantheitemtypein'tavailable.UNKNOWN(0)meantheitemtypein'tknown.USERDATA(14)meanuerdata.USERID(1792)meanuerIDname.
以下代码返回inbo某中的最后一封邮件的body的类型,
SubClick()
DimeionDimdbDimviewDimdocDimentDimfilDimiteDimdoc1Dimembfil=0ite=0emb=0
Seteion=CreateObject(\
Setdb=eion.GETDATABASE(\Setview=db.GetView(\Setdoc=view.getlatdocumentSetdoc1=doc.getfirtitem(\
MgBo某doc1.Type
Endub
结果
24,notedocument和noterichte某titem在有附件时候的区别,
结果
也就是说,notedocument是支持haembedded属性的,而noterichte某titem是不支持的,
同时,noteitem也没有这个属性,因为richte某titem是item的一种子类型,
注意以下的语句,
想通过以上的代码首先判断最后一封邮件中是否有附件,如果有,则依次返回其名称,结果,
原因如下,
UnliketheEmbeddedObjectpropertyinNoteRichTe某tItem,thipropertydoenotincludefileattachment,norOLE/1objectcreatedinNoteReleae3.
ThipropertydoeincludeOLE/2andOLE/1objectcreatedinNoteReleae4.Italoincludeobjectinthedocumentthatwereoriginallyembeddedinthedocument'form.Suchobjectmuthavebeenactivated,modified,andre-avedinordertobereturn
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 操纵 Lotusnotes 邮件
![提示](https://static.bdocx.com/images/bang_tan.gif)