用VBA操纵Lotus - notes发邮件

287 , 用lotus notes发送邮件，

第一种方法，

Sub SendWithLotus()

Dim noSession As Object, noDatabase As Object Dim noDocument As Object, noAttachment As Object Dim FileSelf As String Dim i As Long

Const EMBED_ATTACHMENT = 1454

Const stSubject As String = \Dim stMsg As String

FileSelf = ThisWorkbook.Path + \stMsg = \

Application.UserName & vbCrLf & _ vbCrLf & _

\ \

Dim vaRecipient As Variant

vaRecipient = VBA.Array(\ 'Insert Lotus Notes COM object.

Set noSession = CreateObject(\

Set noDatabase = noSession.GETDATABASE(\ If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Set noDocument = noDatabase.CREATEDOCUMENT

Set noAttachment = noDocument.CREATERICHTEXTITEM(\ noAttachment.EMBEDOBJECT EMBED_ATTACHMENT, \

With noDocument .Form = \ .SendTo = vaRecipient .Subject = stSubject .Body = stMsg

.SAVEMESSAGEONSEND = True .PostedDate = Now() .SEND 0, vaRecipient End With

Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing AppActivate \

MsgBox \

End Sub

第二种方法

Sub SendWithLotus()

Dim noSession As Object, noDatabase As Object Dim noDocument As Object, noAttachment As Object Dim vaFiles As Variant Dim i As Long

Const EMBED_ATTACHMENT = 1454

Const stSubject As String = \

Const stMsg As String = \Dim vaRecipient As Variant

vaRecipient = VBA.Array(\

vaFiles = Application.GetOpenFilename(FileFilter:=\Filer (*.xls),*.xls\Title:=\files for outgoing E_Mail\MultiSelect:=True)

If Not IsArray(vaFiles) Then Exit Sub 'Insert Lotus Notes COM object.

Set noSession = CreateObject(\

Set noDatabase = noSession.GETDATABASE(\ If noDatabase.IsOpen = False Then noDatabase.OPENMAIL Set noDocument = noDatabase.CREATEDOCUMENT

Set noAttachment = noDocument.CREATERICHTEXTITEM(\ With noAttachment

For i = 1 To UBound(vaFiles)

.EMBEDOBJECT EMBED_ATTACHMENT, \ Next i End With With noDocument .Form = \ .SendTo = vaRecipient .Subject = stSubject .Body = stMsg

.SAVEMESSAGEONSEND = True .PostedDate = Now() .SEND 0, vaRecipient End With

Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing AppActivate \

MsgBox \ OK\End Sub

1, 返回当前数据库的信息，

a, 返回当前数据库的名称，

结果，

b, 返回当前数据库的文件名，

c, 返回当前数据库的文件路径，

2，发送邮件的一些设置，

Sub aaaaaa()

Dim no As Object Dim db As Object Dim doc As Object Dim fields As Object Dim nofields As Object Dim att As Variant

att = Application.GetOpenFilename(FileFilter:=\Title:=\添加附件

Set no = CreateObject(\建立和邮件的连接 Set db = no.CURRENTDATABASE '建立和邮件数据库的连接 Set doc = db.CREATEDOCUMENT '创建一个新的邮件

Set fields = doc.CREATERICHTEXTITEM(\设置新邮件的正文（附件）对象

With fields '设置邮件的正文和附件

.APPENDTEXT \ this e-mail 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, \ Next i End With

With doc '设置新邮件的除正文和附件外的其他信息

.form = \新邮件

.sendto = VBA.Array(\发送给 .Subject = \主题

.SAVEMESSAGEONSEND = True '是否保存发送的邮件到发件箱 .postdate = DateAdd(\发送日期等于当天 .SEND 0 '发送 End With

MsgBox \

Set no = Nothing '释放内存 Set db = Nothing Set doc = Nothing Set fields = Nothing End Sub

在添加附件的时候，如果只是想将当前的活动工作薄作为附件的话，如下，

注意一下, 如果是1452的话, 效果如下,

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库用VBA操纵Lotus - notes发邮件在线全文阅读。