使用Excel通過Lotus Notes發送電子郵件

Question

我正在寫一個宏代碼來發送電子郵件通過IBM Lotus Notes，我能夠發送給客戶，但錯誤的內容，我已經保存了電子郵件的內容工作表「一般概述」在這裏：

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

但它會自動發送給一個客戶的電子郵件與錯誤的內容好像是沒有，我現在毫無頭緒這一點，並會明白很多的幫助。

下面是整體的一部分：

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 

Dim stSubject As String 
stSubject = "E-Mail For Approval for " + (Sheets("Summary").Cells(i, "A").Value) + " for the Project " + Replace(ActiveWorkbook.Name, ".xls", "") 
'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. 
rngGen.Copy 
rngApp.Copy 
rngspc.Copy 

'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. 
With noDocument 
    .PostedDate = Now() 
    .send 0, vaRecipient 
End With 

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

'Activate Excel for the user. 
'Change Microsoft Excel to Excel 
AppActivate "Excel" 

'Empty the clipboard. 
Application.CutCopyMode = False 

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 stCC 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 
stCC = Sheets("Summary").Cells(i, "V").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) 

'If You experience any issues with the above three lines then replace it with: 
'Call oUIDoc.FieldAppendText("EnterSendTo", stTo) 
'Call oUIDoc.FieldAppendText("EnterCopyTo", stCC) 
'Call oUIDoc.FieldAppendText("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 

Answer 1

剪貼板將由你做的多個副本會被替換。

爲了能夠看到電子郵件和手動發送添加此

CreateObject("Notes.NotesUIWorkspace").EDITDOCUMENT True, oUIDoc AppActivate "> " & oUIDoc.subject

下面 Call oUIDoc.Save(True, False, False)

不能測試，看看是否可以正常工作爲不再讓Lotus Notes。但這與我上一份工作中使用的相同。