[求助][已解决]EXCEL用LOTUS NOTES发邮件

willin2000

为什么我发送的MAIL,附件和信息只能发送其中之一,不能同时包含.

当有下面蓝色语句时只能发附件,收到的邮件没有stMsg, 取消蓝色语句后能收到stMsg.

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 = "For Lotus VBA Programming Test only"
Dim stMsg As String

FileSelf = ThisWorkbook.Path + "\" + ThisWorkbook.Name
stMsg = "Bst & Rgds" & vbCrLf & _
         Application.UserName & vbCrLf & _
                                vbCrLf & _
        "**************************************************************************" & vbCrLf & _
        "(This's an automated e-mail notification, please do not reply this message.)"

Dim vaRecipient As Variant
   
    vaRecipient = VBA.Array("someone@company.com")
    'Insert Lotus Notes COM object.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
    Set noDocument = noDatabase.CreateDocument
    Set noAttachment = noDocument.CreateRichTextItem("Body")
    noAttachment.EmbedObject EMBED_ATTACHMENT, "", FileSelf
   
    With noDocument
        .Form = "Memo"
        .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 "Microsoft Excel"
    MsgBox "This file be sent", vbInformation
End Sub

[此贴子已经被作者于2006-11-29 12:54:01编辑过]

小安

我刚向网管申请了ID，但还不是很会用。帮顶一下。

willin2000

已自己解决,不能用"Body",用其他即可:

Set noAttachment = noDocument.CreateRichTextItem("Body")

改成

Set noAttachment = noDocument.CreateRichTextItem("Body1") 等..

typ8091232

以下是引用willin2000在2006-11-7 12:07:50的发言：

为什么我发送的MAIL,附件和信息只能发送其中之一,不能同时包含.

当有下面蓝色语句时只能发附件,收到的邮件没有stMsg, 取消蓝色语句后能收到stMsg.

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 = "For Lotus VBA Programming Test only"
Dim stMsg As String

FileSelf = ThisWorkbook.Path + "\" + ThisWorkbook.Name
stMsg = "Bst & Rgds" & vbCrLf & _
         Application.UserName & vbCrLf & _
                                vbCrLf & _
        "**************************************************************************" & vbCrLf & _
        "(This's an automated e-mail notification, please do not reply this message.)"

Dim vaRecipient As Variant
   
    vaRecipient = VBA.Array("someone@company.com")
    'Insert Lotus Notes COM object.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
    Set noDocument = noDatabase.CreateDocument
    Set noAttachment = noDocument.CreateRichTextItem("Body")
    noAttachment.EmbedObject EMBED_ATTACHMENT, "", FileSelf
   
    With noDocument
        .Form = "Memo"
        .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 "Microsoft Excel"
    MsgBox "This file be sent", vbInformation
End Sub

willin2000版主,你好.

你的这段CODE我试运行了一下,效果很好!现在有个问题想请教:

vaRecipient = VBA.Array("someone@company.com")

这段语句中的邮件能否以一个变量来代替,如收件人很多我一一输入将很不方便!

我想能不能将收件人都存放在单元格A1中(A1可以通过复选框来控制收件人多少)

请问如何实现呢?

willin2000

循环读取复选框值(或引用单元格值)作为条件来取的对应单元个的EMAIL地址即可.

typ8091232

QUOTE:

以下是引用willin2000在2007-8-17 22:40:00的发言：
循环读取复选框值(或引用单元格值)作为条件来取的对应单元个的EMAIL地址即可.

终于盼到您的回复,我在这方面很菜的,可以为我举个例子吗?或简单写一下代码!

username

Dim recip(2) As Variant    '定义数据，确定邮箱个数
recip(0) = "邮箱1"   '确定邮箱地址
recip(1) = "邮箱2"   '确定邮箱地址
recip(2) = "邮箱3"   '确定邮箱地址

在发送邮件的时候

MailDoc.sendto = recip   即可

typ8091232

以下是引用username在2007-8-18 10:00:26的发言：

Dim recip(2) As Variant    '定义数据，确定邮箱个数
recip(0) = "邮箱1"   '确定邮箱地址
recip(1) = "邮箱2"   '确定邮箱地址
recip(2) = "邮箱3"   '确定邮箱地址

在发送邮件的时候

MailDoc.sendto = recip   即可

非常感谢,另有一个问题想请教,我在公司应用这段代码进行邮件发送时,有的机子可以,有的不行,提示无法创建OBJECT.

不行的机子配置是:XP+OFFICE2003+NOTES  R5

想问一下,原因在那?是不是某个控件缺失,唉,头都大了!

typ8091232

QUOTE:

以下是引用typ8091232在2007-8-18 16:50:10的发言：

以下是引用username在2007-8-18 10:00:26的发言：

Dim recip(2) As Variant    '定义数据，确定邮箱个数
recip(0) = "邮箱1"   '确定邮箱地址
recip(1) = "邮箱2"   '确定邮箱地址
recip(2) = "邮箱3"   '确定邮箱地址

在发送邮件的时候

MailDoc.sendto = recip   即可

非常感谢,另有一个问题想请教,我在公司应用这段代码进行邮件发送时,有的机子可以,有的不行,提示无法创建OBJECT.

不行的机子配置是:XP+OFFICE2003+NOTES  R5

想问一下,原因在那?是不是某个控件缺失,唉,头都大了!

顶一下

willin2000

这个在我的机器上没问题,你试试:

T0igtzeN.zip (15.3 KB, 下载次数: 603)

2007-8-20 11:31 上传

点击文件名下载附件
回复：（typ8091232）以下是引用username在2007-8-18 ...

[此贴子已经被作者于2007-8-20 11:31:11编辑过]