如何在excelvba中用lotusnotes电子邮件添加CC

我有一个从Excel VBA自动向收件人发送电子邮件的宏，我的Excel文件中有不同的列，如“收件人电子邮件地址”和“抄送”，我的宏将从工作表中检索数据，然后相应地格式化。现在我需要在我的电子邮件格式中添加一个带有两个电子邮件地址的“抄送”字段，但我不知道该怎么做，有人能帮我吗

我的工作表如下所示：

以下是宏的完整代码：

Sub Send_Unformatted_Rangedata(i As Integer)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As Variant

Dim rnBody As Range
Dim Data As DataObject
Dim rngGen As Range
Dim rngApp As Range
Dim rngspc As Range

y:

Dim stSubject As String
stSubject = "Change Request " + (Sheets("Summary").Cells(i, "AA").Value) + (Sheets("Summary").Cells(i, "AB").Value) + (Sheets("Summary").Cells(i, "AC").Value) + (Sheets("Summary").Cells(i, "AD").Value) + (Sheets("Summary").Cells(i, "AE").Value) + (Sheets("Summary").Cells(i, "AF").Value) + (Sheets("Summary").Cells(i, "AG").Value) + (Sheets("Summary").Cells(i, "AH").Value) + (Sheets("Summary").Cells(i, "AI").Value)
'Const stMsg As String = "Data as part of the e-mail's body."
'Const stPrompt As String = "Please select the range:"

'This is one technique to send an e-mail to many recipients but for larger
'number of recipients it's more convenient to read the recipient-list from
'a range in the workbook.
vaRecipient = VBA.Array(Sheets("Summary").Cells(i, "U").Value, Sheets("Summary").Cells(i, "V").Value)

On Error Resume Next
'Set rnBody = Application.InputBox(Prompt:=stPrompt, _
     Default:=Selection.Address, Type:=8)
'The user canceled the operation.
'If rnBody Is Nothing Then Exit Sub
Set rngGen = Nothing
'Set rngApp = Nothing
'Set rngspc = Nothing

Set rngGen = Sheets("General Overview").Range("A1:C30").SpecialCells(xlCellTypeVisible)
'Set rngApp = Sheets("Application").Range("A1:E13").SpecialCells(xlCellTypeVisible)

'Set rngspc = Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "Q").Value).SpecialCells(xlCellTypeVisible)
'Set rngspc = Union(rngspc, Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "R").Value).SpecialCells(xlCellTypeVisible))

On Error GoTo 0

If rngGen Is Nothing And rngApp Is Nothing And rngspc Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If


'Instantiate Lotus Notes COM's objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'Make sure Lotus Notes is open and available.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the document for the e-mail.
Set noDocument = noDatabase.CreateDocument

'Copy the selected range into memory.
'The clipboard will get replaced by the multiple copies.
'rngApp.Copy
'rngspc.Copy
rngGen.Copy

'To be able to see the email and manually send it add this below
 'Call oUIDoc.Save(True, False, False)
 'CreateObject("Notes.NotesUIWorkspace").EDITDOCUMENT True, oUIDoc
 'AppActivate "> " & oUIDoc.Subject

'Retrieve the data from then copied range.
Set Data = New DataObject
Data.GetFromClipboard

'Add data to the mainproperties of the e-mail's document.
With noDocument
  .Form = "Memo"
  .SendTo = vaRecipient

  .Subject = stSubject
  'Retrieve the data from the clipboard.
  .Body = Data.GetText & " " & stMsg
  .SAVEMESSAGEONSEND = True
End With

'Send the e-mail.
'changed by Xu Ying to make the email being sent from automatically to manually

    Dim uiMemo As Object
    Dim ws As Object
    Set ws = CreateObject("Notes.NotesUIWorkspace")
    noDocument.Save True, True, False
    Set uiMemo = ws.EDITDOCUMENT(True, noDocument)

'Release objects from memory.
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing


'Activate Excel for the user.

'AppActivate "Excel"

'Empty the clipboard.
Application.CutCopyMode = False

i = i + 1
If Sheets("Summary").Cells(i, "U").Value <> "" Then
GoTo y:
End If

MsgBox "The e-mail has successfully been created and distributed.", vbInformation

End Sub

Sub Send_Formatted_Range_Data(i As Integer)
Dim oWorkSpace As Object, oUIDoc As Object
Dim rnBody As Range
Dim lnRetVal As Long
Dim stTo As String

Dim stSubject As String
Const stMsg As String = "An e-mail has been succesfully created and saved."

Dim rngGen As Range
Dim rngApp As Range
Dim rngspc As Range

stTo = Sheets("Summary").Cells(i, "U").Value

stSubject = "E-Mail For Approval for " + (Sheets("Summary").Cells(i, "A").Value) + "  for the Project  " + Replace(ActiveWorkbook.Name, ".xls", "")

'Check if Lotus Notes is open or not.
lnRetVal = FindWindow("NOTES", vbNullString)

If lnRetVal = 0 Then
  MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
  Exit Sub
End If

Application.ScreenUpdating = False

Set rngGen = Sheets("General Overview").Range("A1:C30").SpecialCells(xlCellTypeVisible)
Set rngApp = Sheets("Application").Range("A1:E13").SpecialCells(xlCellTypeVisible)

Set rngspc = Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "Q").Value).SpecialCells(xlCellTypeVisible)
Set rngspc = Union(rngspc, Sheets(Sheets("Summary").Cells(i, "P").Value).Range(Sheets("Summary").Cells(i, "R").Value).SpecialCells(xlCellTypeVisible))
On Error GoTo 0

If rngGen Is Nothing And rngApp Is Nothing And rngspc Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

rngGen.Copy
rngApp.Copy
rngspc.Copy

'Instantiate the Lotus Notes COM's objects.
Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")

On Error Resume Next

Set oUIDoc = oWorkSpace.ComposeDocument("", "mail\xldennis.nsf", "Memo")
On Error GoTo 0

Set oUIDoc = oWorkSpace.CurrentDocument

'Using LotusScript to create the e-mail.
Call oUIDoc.FieldSetText("EnterSendTo", stTo)
Call oUIDoc.FieldSetText("EnterCopyTo", stCC)
Call oUIDoc.FieldSetText("Subject", stSubject)

'The can be used if You want to add a message into the created document.
Call oUIDoc.FieldAppendText("Body", vbNewLine & stBody)

'Here the selected range is pasted into the body of the outgoing e-mail.
Call oUIDoc.GoToField("Body")
Call oUIDoc.Paste

'Save the created document.
Call oUIDoc.Save(True, False, False)
'If the e-mail also should be sent then add the following line.
'Call oUIDoc.Send(True)

'Release objects from memory.
Set oWorkSpace = Nothing
Set oUIDoc = Nothing

With Application
  .CutCopyMode = False
  .ScreenUpdating = True
End With

MsgBox stMsg, vbInformation

'Activate Lotus Notes.
AppActivate ("Notes")
'Last edited Feb 11, 2015 by Peter Moncera

End Sub

子发送\u未格式化\u范围数据（i为整数）
Dim noSession作为对象，NodeDatabase作为对象，NodeDocument作为对象
暗变异体
变暗rnBody As范围
作为数据对象的Dim数据
Dim rngGen As射程
Dim rngApp As范围
Dim rngspc As范围
y:
将主题设置为字符串
stSubject=“变更请求”+（表（“摘要”）.单元格（i，“AA”）.值）+（表（“摘要”）.单元格（i，“AB”）.值）+（表（“摘要”）.单元格（i，“AC”）.值）+（表（“摘要”）.单元格（i，“AD”）.值）+（表（“摘要”）.单元格（i，“AE”）.值）+（表（“摘要”）.单元格（i，“AF”）.值）+（表（“摘要”）.单元格（i，“AF”）.值）+（表（“摘要”）).单元格（i，“AH”）.值+（表格（“摘要”）.单元格（i，“AI”）.值）
'Const stMsg As String=“数据作为电子邮件正文的一部分。”
'Const stPrompt As String=“请选择范围：”
“这是一种向许多收件人发送电子邮件的技术，但适用于更大的收件人
'收件人数量从中读取收件人列表更方便
'工作簿中的范围。
vaRecipient=VBA.数组（表（“摘要”）.单元格（i，“U”）.值，表（“摘要”）.单元格（i，“V”）.值）
出错时继续下一步
'设置rnBody=Application.InputBox（提示符：=stPrompt_
默认值：=Selection.Address，类型：=8）
'用户取消了该操作。
'如果rnBody为空，则退出Sub
设置rngGen=Nothing
'设置rngApp=Nothing
'设置rngspc=无
Set rngGen=板材（“一般概述”）.范围（“A1:C30”）.特殊单元（XLCELLTYPE可见）
'Set rngApp=板材（“应用”）.范围（“A1:E13”）.特殊单元（xlCellTypeVisible）
'设置rngspc=表格（表格（“摘要”）.单元格（i，“P”）.值）.范围（表格（“摘要”）.单元格（i，“Q”）.值）.特殊单元格（xlCellTypeVisible）
'Set rngspc=Union（rngspc，表格（表格（“摘要”）.单元格（i，“P”）.值）.范围（表格（“摘要”）.单元格（i，“R”）.值）.特殊单元格（xlCellTypeVisible））
错误转到0
如果rngGen什么都不是，rngApp什么都不是，rngspc什么都不是，那么
MsgBox“所选内容不是范围或工作表受保护。”&_
vbNewLine&“请更正并重试。”，vbOKOnly
出口接头
如果结束
'实例化Lotus Notes COM的对象。
Set noSession=CreateObject（“Notes.notesession”）
Set noDatabase=noSession.GETDATABASE（“，”）
'确保Lotus Notes已打开且可用。
如果noDatabase.IsOpen=False，则noDatabase.OPENMAIL
'为电子邮件创建文档。
设置noDocument=noDatabase.CreateDocument
'将所选范围复制到内存中。
'剪贴板将被多个副本替换。
'rngApp.Copy
'rngspc.Copy
朗根，收到
'要查看电子邮件并手动发送，请在下面添加此项
'调用oUIDoc.Save（真、假、假）
'CreateObject（“Notes.NotesUIWorkspace”）.EDITDOCUMENT True，oUIDoc
“AppActivate”>”和oUIDoc.Subject
'从复制的范围中检索数据。
设置数据=新数据对象
Data.GetFromClipboard
'将数据添加到电子邮件文档的主要属性。
没有文件
.Form=“备忘录”
.SendTo=vaRecipient
.Subject=stSubject
'从剪贴板检索数据。
.Body=Data.GetText&“”&stMsg
.SAVEMESSAGEONSEND=True
以
'发送电子邮件。
'由徐颖更改为自动发送电子邮件为手动发送
作为对象的对象
将ws设置为对象
设置ws=CreateObject（“Notes.NotesUIWorkspace”）
noDocument.保存真、真、假
Set uiMemo=ws.EDITDOCUMENT（True，noDocument）
'从内存中释放对象。
设置noDocument=Nothing
Set noDatabase=Nothing
设为零
'为用户激活Excel。
'激活“Excel”
'清空剪贴板。
Application.CutCopyMode=False
i=i+1
如果表格（“摘要”）.单元格（i，“U”）.值为“”，则
转到y：
如果结束
MsgBox“电子邮件已成功创建和分发”。vbInformation
端接头
子发送\u格式的\u范围\u数据（i为整数）
Dim oWorkSpace作为对象，oUIDoc作为对象
变暗rnBody As范围
暗淡的内景，如长
将stTo设置为字符串
将主题设置为字符串
Const stMsg As String=“已成功创建并保存电子邮件。”
Dim rngGen As射程
Dim rngApp As范围
Dim rngspc As范围
stTo=表格（“汇总”）。单元格（i，“U”）值
stSubject=“项目“+（表格（“摘要”）.Cells（i，“A”）.Value）+”的审批电子邮件“+替换（ActiveWorkbook.Name，.xls，”）
'检查Lotus Notes是否已打开。
lnRetVal=FindWindow（“注释”，vbNullString）
如果lnRetVal=0，则
MsgBox“请确保Lotus Notes处于打开状态！”，vb感叹号
出口接头
如果结束
Application.ScreenUpdating=False
Set rngGen=板材（“一般概述”）.范围（“A1:C30”）.特殊单元（XLCELLTYPE可见）
设置rngApp=Sheets（“应用”）.范围（“A1:E13”）.特殊单元格（xlCellTypeVisible）
设置rngspc=表格（表格（“摘要”）.单元格（i，“P”）.值）.范围（表格（“摘要”）.单元格（i，“Q”）.值）.特殊单元格（xlCellTypeVisible）
设置rngspc=Union（rngspc，表格（表格（“摘要”）.单元格（i，“P”）.值）。范围（表格（“摘要”）.单元格（i，“R”）.值）。特殊单元格（xlCellTypeVisible））
错误转到0
如果rngGen什么都不是，rngApp什么都不是，rngspc什么都不是，那么
MsgBox“所选内容不是范围或工作表受保护。”&_
vbNewLine&“请更正并重试。”，vbOKOnly
出口接头
如果结束
朗根，收到
rngApp，收到
收到
'实例化Lotus Notes COM的对象。
设置oWorkSpace=CreateObject（“Notes.NotesUIWorkspace”）
出错时继续下一步
Set-oUIDoc=oWorkSpace.ComposeDocument（“，“mail\xldennis.nsf”，“Memo”）
错误转到0
设置oUIDoc=oWorkSpace.CurrentDocument
'使用LotusScript创建电子邮件。
打电话给你
vaCC = VBA.Array(Sheets("Summary").Cells(i, "AA").Value, Sheets("Summary").Cells(i, "AB").Value, Sheets("Summary").Cells(i, "AC").Value)

With noDocument
  .CopyTo = vaCC
End With