用VBA操纵Lotus notes发邮件.docx
《用VBA操纵Lotus notes发邮件.docx》由会员分享，可在线阅读，更多相关《用VBA操纵Lotus notes发邮件.docx（31页珍藏版）》请在冰豆网上搜索。
用VBA操纵Lotusnotes发邮件
287,用lotusnotes发送邮件，
第一种方法，
SubSendWithLotus（）
DimnoSessionAsObject,noDatabaseAsObject
DimnoDocumentAsObject,noAttachmentAsObject
DimFileSelfAsString
DimiAsLong
ConstEMBED_ATTACHMENT=1454
ConststSubjectAsString="ForLotusVBAProgrammingTestonly"
DimstMsgAsString
FileSelf=+"\"+
stMsg="Bst&Rgds"&vbCrLf&_
&vbCrLf&_
vbCrLf&_
"**************************************************************************"&vbCrLf&_
"（This'sanautomatede-mailnotification,pleasedonotreplythismessage.）"
DimvaRecipientAsVariant
vaRecipient=（""）
'InsertLotusNotesCOMobject.
SetnoSession=CreateObject（""）
SetnoDatabase=（"","D:
\notes\data\mail3\"）
If=FalseThen
SetnoDocument=
SetnoAttachment=（"Body"）
EMBED_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
vaRecipient=（"",""）
vaFiles=（FileFilter:
="ExcelFiler（*.xls）,*.xls",Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True）
IfNotIsArray（vaFiles）ThenExitSub
'InsertLotusNotesCOMobject.
SetnoSession=CreateObject（""）
SetnoDatabase=（"","D:
\notes\data\mail3\"）
If=FalseThen
SetnoDocument=
SetnoAttachment=（"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=（FileFilter:
="ExcelFiler（*.xls）,*.xls",_
Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True）'添加附件
Setno=CreateObject（""）'建立和邮件的连接
Setdb='建立和邮件数据库的连接
Setdoc='创建一个新的邮件
Setfields=（"body"）'设置新邮件的正文（附件）对象
Withfields'设置邮件的正文和附件
.APPENDTEXT"thise-mailisgeneratedbyanautomatedprocessjustforatest"
.ADDNEWLINE1'增加第一行
.APPENDTEXT"pleasedonotreply."
.ADDNEWLINE2'增加第二行
Fori=1ToUBound（att）'添加附件
.EMBEDOBJECT1454,"",att（i）
Nexti
EndWith
Withdoc'设置新邮件的除正文和附件外的其他信息
.form="Memo"'新邮件
.sendto=（"",""）'发送给
.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,用上面的方法提取出来的发件人是有公司名称的，
（"from"）（0））.ABBREVIATED
如果不使用abbreviated,则结果为，
如果想要输出的发件人只有名字，没有公司名的话，可以做如下更改，
结果为，
排版之后的效果如下所示，
5,如果想要将附件保存到指定的文件夹的话，
以上代码是将发件箱中的附件保存到D盘的新建文件夹，
以下将发件箱改成自定义的文件夹，”HR－information”
6,用以下方法也可以获得附件的名称，
结果，
也可以将改成,结果一样，
结果，
以上代码是获取发件箱中的第一个邮件的附件名称，
7,设置发送邮件时的邮件正文，
以上的代码中，其实withfields和withdoc都是设置邮件的正文，
withfields,是设置邮件的正文和附件信息，
withdoc,是设置邮件的发送人，是否保存到发件箱等一些其他的信息，
8,在发送邮件的时候，要注意body的问题，
a,如果自始至终都使用body来添加附件和正文的话，则添加的正文就不会出现，就只有附件，
发送后的结果，
注意，以上发送出去的邮件是没有正文的，只有附件，就是说以上的代码用withdoc添加的body正文没有添加成功，
如果想要有正文的话，有两个办法，
第一，将第一个括号里面的body改成和第三个红框里面的body不同的字符，
结果，
注意，这样更改后的结果就是，发送的邮件的正文文本和附件之间有一条线分隔，
第二种方法，就是用appendtext方法添加空行的方法，
以上的代码就是通过添加空行，添加文本的方法来添加正文文本部分，
结果，
9,枚举所有folder的名称，
结果，
以上代码是返回所有的文件夹，
以下的代码返回的是非文件夹，
结果，
10,如果想要将发件人的名称改成其他的名称，比如groupsender,可以做如下设置，
请注意以上代码中的红色框框部分，加上=“groupsender”，收到的邮件的发件人就会显示groupsender,
结果，
11,如果在没有打开邮箱的情况下想发送邮件，可以设置如下
Subabb（）
DimMaildbAsObject
DimMailDocAsObject
DimBodyAsObject
DimSessionAsObject
'Startasessiontonotes
SetSession=CreateObject（""）
'ThislinepromptsforpasswordofcurrentIDnotedin
Call
'orusebelowtosupplypasswordofthecurrentID
'Call（""）
'Openthemaildatabaseinnotes
SetMaildb=（"","D:
\notes\data\mail3\"）
IfNot=TrueThen
Call
EndIf
'Createthemaildocument
SetMailDoc=
Call（"Form","Memo"）
'Settherecipient
Call（"SendTo",""）
'Setsubject
Call（"Subject","SubjectText"）
'CreateandsettheBodycontent
SetBody=（"Body"）
Call（"Bodytexthere"）
'Exampletocreateanattachment（optional）
Call
（2）
Call（1454,"",
'Exampletosavethemessage（optional）
=True
'Sendthedocument
'GetsthemailtoappearintheSentitemsfolder
Call（"PostedDate",Now（））
Call（False）
'CleanUp
SetMaildb=Nothing
SetMailDoc=Nothing
SetBody=Nothing
SetSession=Nothing
EndSub
结果，
首先会要求输入密码，
这样的话，不用打开lotusnotes就可以发送邮件了
如果不想每次都手动的输入密码的话，可以如下设置，
call（“密码”）
Subabb（）
DimMaildbAsObject
DimMailDocAsObject
DimBodyAsObject
DimSessionAsObject
SetSession=CreateObject（""）
Call（"ilove1237"）
SetMaildb=（"","D:
\notes\data\mail3\"）
IfNot=TrueThen
Call
EndIf
SetMailDoc=
Call（"Form","Memo"）
Call（"SendTo",""）
Call（"Subject","SubjectText"）
SetBody=（"Body"）
Call（"Bodytexthere"）
Call
（2）
Call（1454,"",
=True
Call（"PostedDate",Now（））
Call（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（""）
Setanotes=CreateObject（""）
SetaDataBase=（"","D:
\notes\data\mail3\"）
Setnotesdoc=
Setuidoc=（True,notesdoc）
Call（"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=（FileFilter:
="ExcelFiler（*.xls）,*.xls",_
Title:
="AttachfilesforoutgoingE_Mail",MultiSelect:
=True）'添加附件
SetSession=CreateObject（""）
（"ilove1237"）
SetMaildb=（"","D:
\notes\data\mail3\"）
IfNot=TrueThen
Call
EndIf
SetMailDoc=
Call（"Form","Memo"）
Call（"SendTo",arr）
Call（"Subject","SubjectText"）
SetBody=（"Body"）
Call（"Bodytexthere"）
Call
（2）
Fori=1ToUBound（att）
Call（1454,"",att（i））
Nexti
=True
Call（"PostedDate",Now（））
Call（False）
SetMaildb=Nothing
SetMailDoc=Nothing
SetBody=Nothing
SetSession=Nothing
MsgBox"发送成功!
"
EndSub
结果，
19,如何用VBS发邮件，
Dimmydocu,os,myBody
Setos=CreateObject（""）
SetmyDocu=myBody=（"Body"）
withmybody
.appendtext"thise-mailisgeneratedbyautomatedprocess,youdon'tneedtoreply"
.addnewline2
.embedobject1454,"","C:
\DocumentsandSettings\tony\桌面\overhead"
endwith
withmydocu
.SendTo=""
.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（""）'建立和邮件的连接
Setdb=
Setdoc=
Setfield=（"body"）
Setclipboard=NewDataObject
Withfield
.AppendText"此邮件为系统自动发送，请不要回复，仅作为测试使用！
"
.AddNewLine2
.AppendText
（1）
EndWith
Withdoc
.form="Memo"
.sendto=""
.Subject="自动邮件"
.SaveMessageOnSend=True
.postdate=Now（）
.Send0
EndWith
Selection
（1）.Select
=False
EndSub
发送的效果如下图,
21,在发送附件的时候要注意的问题,
以下的代码的目的是发送带附件的邮件,但是有个问题值得注意:
下面的正文部分和收件人信息部分不能置换位置,如果将收件人信息放在正文上方,则发出的邮件正文部分为空白,
22,如何避免在用循环发送多个邮件的时候,出现所有的附件都集中在一个邮件中的情况,
如果以上面的代码发送邮件的话,就会出现所有的邮件都集中在一个邮件中的情况,
效果如下,
原因为:
VBA和Lotusnotes执行不同步造成的,因为当lotusnotes还没有处理完前一个邮件的时候,VBA已经执行到下一个循环了,
解决办法:
执行完一个循环,就将设置正文及标题信息的doc对象设置成nothing,然后到下一个循环的时候,再用set函数创建,
发送后的效果如下所示:
23,notesview的type值,
•ACTIONCD（16）meanssavedactionCDrecords;non-Computable;canonicalform.
•ASSISTANTINFO（17）meanssavedassistantinformation;
升级会员 