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的话, 效果如下,