用VBA操纵Lotus notes发邮件.docx
《用VBA操纵Lotus notes发邮件.docx》由会员分享,可在线阅读,更多相关《用VBA操纵Lotus notes发邮件.docx(36页珍藏版)》请在冰豆网上搜索。
用VBA操纵Lotusnotes发邮件
287,用lotusnotes发送邮件,
第一种方法,
SubSendWithLotus()
DimnoSessionAsObject,noDatabaseAsObject
DimnoDocumentAsObject,noAttachmentAsObject
DimFileSelfAsString
DimiAsLong
ConstEMBED_ATTACHMENT=1454
ConststSubjectAsString="ForLotusVBAProgrammingTestonly"
DimstMsgAsString
FileSelf=ThisWorkbook.Path+"\"+ThisWorkbook.Name
stMsg="Bst&Rgds"&vbCrLf&_
Application.UserName&vbCrLf&_
vbCrLf&_
"**************************************************************************"&vbCrLf&_
"(This'sanautomatede-mailnotification,pleasedonotreplythismessage.)"
DimvaRecipientAsVariant
'InsertLotusNotesCOMobject.
SetnoSession=CreateObject("Notes.NotesSession")
SetnoDatabase=noSession.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
IfnoDatabase.IsOpen=FalseThennoDatabase.OPENMAIL
SetnoDocument=noDatabase.CREATEDOCUMENT
SetnoAttachment=noDocument.CREATERICHTEXTITEM("Body")
noAttachment.EMBEDOBJECTEMBED_ATTACHMENT,"",FileSelf
WithnoDocument
.Form="Memo"
.SendTo=vaRecipient
.Subject=stSubject
.Body=stMsg
.SAVEMESSAGEONSEND=True
.PostedDate=Now()
.SEND0,vaRecipient
EndWith
SetnoDocument=Nothing
SetnoDatabase=Nothing
SetnoSession=Nothing
AppActivate"MicrosoftExcel"
MsgBox"Thisfilebesent",vbInformation
EndSub
第二种方法
SubSendWithLotus()
DimnoSessionAsObject,noDatabaseAsObject
DimnoDocumentAsObject,noAttachmentAsObject
DimvaFilesAsVariant
DimiAsLong
ConstEMBED_ATTACHMENT=1454
ConststSubjectAsString="ForLotusVBAProgrammingTestonly"
ConststMsgAsString="Thisfileisforyou!
justforreference"&vbCrLf&"IamStanleyPan"
DimvaRecipientAsVariant
vaFiles=Application.GetOpenFilename(FileFilter:
="ExcelFiler(*.xls),*.xls",Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True)
IfNotIsArray(vaFiles)ThenExitSub
'InsertLotusNotesCOMobject.
SetnoSession=CreateObject("Notes.NotesSession")
SetnoDatabase=noSession.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
IfnoDatabase.IsOpen=FalseThennoDatabase.OPENMAIL
SetnoDocument=noDatabase.CREATEDOCUMENT
SetnoAttachment=noDocument.CREATERICHTEXTITEM("Body")
WithnoAttachment
Fori=1ToUBound(vaFiles)
.EMBEDOBJECTEMBED_ATTACHMENT,"",vaFiles(i)
Nexti
EndWith
WithnoDocument
.Form="Memo"
.SendTo=vaRecipient
.Subject=stSubject
.Body=stMsg
.SAVEMESSAGEONSEND=True
.PostedDate=Now()
.SEND0,vaRecipient
EndWith
SetnoDocument=Nothing
SetnoDatabase=Nothing
SetnoSession=Nothing
AppActivate"MicrosoftExcel"
MsgBox"ThisfileissendOK",vbInformation
EndSub
1,返回当前数据库的信息,
a,返回当前数据库的名称,
结果,
b,返回当前数据库的文件名,
c,返回当前数据库的文件路径,
2,发送邮件的一些设置,
Subaaaaaa()
DimnoAsObject
DimdbAsObject
DimdocAsObject
DimfieldsAsObject
DimnofieldsAsObject
DimattAsVariant
att=Application.GetOpenFilename(FileFilter:
="ExcelFiler(*.xls),*.xls",_
Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True)'添加附件
Setno=CreateObject("notes.notessession")'建立和邮件的连接
Setdb=no.CURRENTDATABASE'建立和邮件数据库的连接
Setdoc=db.CREATEDOCUMENT'创建一个新的邮件
Setfields=doc.CREATERICHTEXTITEM("body")'设置新邮件的正文(附件)对象
Withfields'设置邮件的正文和附件
.APPENDTEXT"thise-mailisgeneratedbyanautomatedprocessjustforatest"
.ADDNEWLINE1'增加第一行
.APPENDTEXT"pleasedonotreply."
.ADDNEWLINE2'增加第二行
Fori=1ToUBound(att)'添加附件
.EMBEDOBJECT1454,"",att(i)
Nexti
EndWith
Withdoc'设置新邮件的除正文和附件外的其他信息
.form="Memo"'新邮件
.Subject="thismailisjustfortesting"'主题
.SAVEMESSAGEONSEND=True'是否保存发送的邮件到发件箱
.postdate=DateAdd("d",1,Date)'发送日期等于当天
.SEND0'发送
EndWith
MsgBox"successfullysentoutthemail!
"
Setno=Nothing'释放内存
Setdb=Nothing
Setdoc=Nothing
Setfields=Nothing
EndSub
在添加附件的时候,如果只是想将当前的活动工作薄作为附件的话,如下,
注意一下,如果是1452的话,效果如下,
会出现一个提示,询问文档包含外部对象链接,是否要更新链接,如果确定的话,效果如下,
会将EXCEL文件中的内容以图片形式打开,同时文件是只读格式的,
如果是1453,效果如下,
不会有提示,但是文件为只读,
如果为1454,则为正常的EXCEL文件格式,
3,提取邮件的一些信息,
以上的发件人,发送时间,主题等信息还可以如下表示,
运行结果,
4,指定是在收件箱,发件箱或其他自定义的文件夹,
a,收件箱等邮箱本身就存在的,
b,如果是自己创建的文件夹及子文件夹,
比如在我的邮箱中有自定义的文件夹,folders,如果要想获取其下面的子文件夹之一的相关资料,则应如下书写,
4,用上面的方法提取出来的发件人是有公司名称的,
anotes.CREATENAME(adocument.GETITEMVALUE("from")(0)).ABBREVIATED
如果不使用abbreviated,则结果为,
如果想要输出的发件人只有名字,没有公司名的话,可以做如下更改,
结果为,
排版之后的效果如下所示,
5,如果想要将附件保存到指定的文件夹的话,
以上代码是将发件箱中的附件保存到D盘的新建文件夹,
以下将发件箱改成自定义的文件夹,”HR-information”
6,用以下方法也可以获得附件的名称,
结果,
也可以将oemb.source改成oemb.name,结果一样,
结果,
以上代码是获取发件箱中的第一个邮件的附件名称,
7,设置发送邮件时的邮件正文,
以上的代码中,其实withfields和withdoc都是设置邮件的正文,
withfields,是设置邮件的正文和附件信息,
withdoc,是设置邮件的发送人,是否保存到发件箱等一些其他的信息,
8,在发送邮件的时候,要注意body的问题,
a,如果自始至终都使用body来添加附件和正文的话,则添加的正文就不会出现,就只有附件,
发送后的结果,
注意,以上发送出去的邮件是没有正文的,只有附件,就是说以上的代码用withdoc添加的body正文没有添加成功,
如果想要有正文的话,有两个办法,
第一,将第一个括号里面的body改成和第三个红框里面的body不同的字符,
结果,
注意,这样更改后的结果就是,发送的邮件的正文文本和附件之间有一条线分隔,
第二种方法,就是用appendtext方法添加空行的方法,
以上的代码就是通过添加空行,添加文本的方法来添加正文文本部分,
结果,
9,枚举所有folder的名称,
结果,
以上代码是返回所有的文件夹,
以下的代码返回的是非文件夹,
结果,
10,如果想要将发件人的名称改成其他的名称,比如groupsender,可以做如下设置,
请注意以上代码中的红色框框部分,加上doc.principal=“groupsender”,收到的邮件的发件人就会显示groupsender,
结果,
11,如果在没有打开邮箱的情况下想发送邮件,可以设置如下
Subabb()
DimMaildbAsObject
DimMailDocAsObject
DimBodyAsObject
DimSessionAsObject
'Startasessiontonotes
SetSession=CreateObject("Lotus.NotesSession")
'ThislinepromptsforpasswordofcurrentIDnotedinNotes.INI
CallSession.Initialize
'orusebelowtosupplypasswordofthecurrentID
'CallSession.Initialize("")
'Openthemaildatabaseinnotes
SetMaildb=Session.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
IfNotMaildb.IsOpen=TrueThen
CallMaildb.Open
EndIf
'Createthemaildocument
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE("Form","Memo")
'Settherecipient
'Setsubject
CallMailDoc.REPLACEITEMVALUE("Subject","SubjectText")
'CreateandsettheBodycontent
SetBody=MailDoc.CREATERICHTEXTITEM("Body")
CallBody.APPENDTEXT("Bodytexthere")
'Exampletocreateanattachment(optional)
CallBody.ADDNEWLINE
(2)
CallBody.EMBEDOBJECT(1454,"",ActiveWorkbook.FullName)
'Exampletosavethemessage(optional)
MailDoc.SAVEMESSAGEONSEND=True
'Sendthedocument
'GetsthemailtoappearintheSentitemsfolder
CallMailDoc.REPLACEITEMVALUE("PostedDate",Now())
CallMailDoc.SEND(False)
'CleanUp
SetMaildb=Nothing
SetMailDoc=Nothing
SetBody=Nothing
SetSession=Nothing
EndSub
结果,
首先会要求输入密码,
这样的话,不用打开lotusnotes就可以发送邮件了
如果不想每次都手动的输入密码的话,可以如下设置,
callsession.initialize(“密码”)
Subabb()
DimMaildbAsObject
DimMailDocAsObject
DimBodyAsObject
DimSessionAsObject
SetSession=CreateObject("lotus.NotesSession")
CallSession.Initialize("ilove1237")
SetMaildb=Session.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
IfNotMaildb.IsOpen=TrueThen
CallMaildb.Open
EndIf
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE("Form","Memo")
CallMailDoc.REPLACEITEMVALUE("Subject","SubjectText")
SetBody=MailDoc.CREATERICHTEXTITEM("Body")
CallBody.APPENDTEXT("Bodytexthere")
CallBody.ADDNEWLINE
(2)
CallBody.EMBEDOBJECT(1454,"",ActiveWorkbook.FullName)
MailDoc.SAVEMESSAGEONSEND=True
CallMailDoc.REPLACEITEMVALUE("PostedDate",Now())
CallMailDoc.SEND(False)
SetMaildb=Nothing
SetMailDoc=Nothing
SetBody=Nothing
SetSession=Nothing
MsgBox"发送成功!
"
EndSub
结果如下,
12,如果想要设置发送邮件时候的抄送等信息,设置如下,
结果,
如果想要发送给多个收件人,则设置如下,
结果,
13,如果想要在发出的邮件中添加当前的签名的话,可以设置如下,
其中,
如果当前的签名不是文本,而是图片的话,这句代码就会返回作为当前签名的图片的名称和存放地址,
说明我当前的签名图片是存放在D盘的photo1文件夹中的,图片名称为邮件,
如下,
最后发送出去的结果如下所示,
可以看到,签名在此时就是图片的地址,因为其不是一段文本,所以才会这样,
而如果签名为文本的时候,效果如下,
以上就是上面这句代码返回的文本签名的内容,
发送出去的邮件如下所示,
14,如果想要进行正文文本的排版的话(即分段隔行等),设置如下,
注意几个地方,
一个是addnewline,在一句话完了之后的第一个vbnewline是起换行的作用,而第二个vbnewline才是新添加一个空行,
二个是在这种情况下,如果通过doc的body属性添加正文文本的话,则在声明fields的时候,不能也使用body,要使用不同于body的名字,
效果如下,
要达到同样的效果,还有一种方法,
请注意,上面的代码中,有addnewline,在其后面的数字表示添加的行数,一般如果是隔行的话,则要添加两行,一行起换行作用,一行为添加的空行,
最终效果如下,
15,返回邮件服务器的名称,
结果,
结果,
16,返回notes的用户名,
1,
结果,
2,
结果,
17,打开一个新邮件,并且将光标移到发件人,抄送人,或正文等处
Subaaa()
Dimanotes
DimaDataBase
Dimaview
Dimitotal
Dimadocument
Dimws
Dimnotesdoc
Setws=CreateObject("Notes.NotesUIWorkspace")
Setanotes=CreateObject("Notes.NotesSession")
SetaDataBase=anotes.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
Setnotesdoc=aDataBase.CREATEDOCUMENT
Setuidoc=ws.EDITDOCUMENT(True,notesdoc)
Calluidoc.GOTOFIELD("Body")
EndSub
执行完以上的代码之后,光标会移到邮件的正文,处于编辑状态,
如果将body换成subject的话,光标就会处于收件人处,
18,如何根据工作表中多个邮箱地址发邮件,
Sub发送邮件()
DimMaildbAsObject
DimMailDocAsObject
DimBodyAsObject
DimSessionAsObject
Dimatt
Dimarr
x=Sheets
(1).Range("a65536").End(xlUp).Row
ReDimarr(1Tox)
Fory=1Tox
arr(y)=Sheets
(1).Cells(y,1)
Nexty
att=Application.GetOpenFilename(FileFilter:
="ExcelFiler(*.xls),*.xls",_
Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True)'添加附件
SetSession=CreateObject("lotus.NotesSession")
Session.Initialize("ilove1237")
SetMaildb=Session.GETDATABASE("","D:
\notes\data\mail3\tonyhf.nsf")
IfNotMaildb.IsOpen=TrueThen
CallMaildb.Open
EndIf
SetMailDoc=Maildb.CREATEDOCUMENT
CallMailDoc.REPLACEITEMVALUE("Form","Memo")
CallMailDoc.REPLACEITEMVALUE("SendTo",arr)
CallMailDoc.REPLACEITEMVALUE("Subject","SubjectText")
SetBody=MailDoc.CREATERICHTEXTITEM("Body")
CallBody.APPENDTEXT("Bodytexthere")
CallBody.ADDNEWLINE
(2)
Fori=1ToUBound(att)
CallBody.EMBEDOBJECT(1454,"",att(i))
Nexti
MailDoc.SAVEMESSAGEONSEND=True
CallMailDoc.REPLACEITEMVALUE("PostedDate",Now())
CallMailDoc.SEND(False)
SetMaildb=Nothing
SetMailDoc=Nothing
SetBody=Nothing
SetSession=Nothing
MsgBox"发送成功!
"
EndSub
结果,
19,如何用VBS发邮件,
Dimmydocu,os,myBody
Setos=CreateObject("Notes.NotesSession")
SetmyBody=myDocu.CREATERICHTEXTITEM("Body")
withmybody
.appendtext"thise-mailisgeneratedbyautomatedprocess,youdon'tneedtoreply"
.addnewline2
.embedobject1454,"","C:
\DocumentsandSettings\tony\桌面\overheadgroup.xls"
endwith
withmydocu
.CopyTo=""
.Subject="thisisfortest"
.SEND0
endwith
msgbox"发送邮件成功!
",vbinformation,"提示"
SetmyDocu=Nothing
SetmyBody=Nothing
Setos=Nothing
发送方法,
双击VBS图标即可,
20,如何将excel的部分内容作为richtext格式粘贴在邮件中,
Subaa()
DimnoAsObject
DimdbAsObject
DimclipboardAsDataObject
DimdocAsObject
DimfieldAsObject
Setno=CreateObject("notes.notessession")'建立和邮件的连接
Setdb=no.CurrentDatabase
Setdoc=db.CreateDocument
Setfield=doc.CreateRichTextItem("body")
Selection.Copy
Setclipboard=NewDataObject
clipboard.GetFromClipboard
Withfield
.App