无法在Excel中手动发送Lotus Notes电子邮件
我试图使用macros发送Lotus Notes电子邮件给客户，我可以自动发送，但如果有什么我想发送之前添加它，所以我想把它设置为手动模式，所以我可以先查看电子邮件，发送前可能会做一些修改，所以我的问题是我该如何修改？ 我有一些方法，但他们不工作。
然后我会用自动发送function发布我的整个代码：
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 我为莲花笔记发送或显示的代码如下所示，您需要修改代码。 对我来说，activecell.offset（0,11）有写或发送“显示”。
'Send the document If ActiveCell.Offset(0, 11).Value = "Send" Then MailDoc.SAVEMESSAGEONSEND = True MailDoc.PostedDate = Now() Call MailDoc.Send(0, ActiveCell.Offset(0, 7).Value) Else MailDoc.Save True, True, False Set uiMemo = ws.EditDocument(True, MailDoc) End If
编辑上面的代码是用于如果您想要选项发送/显示基于您的电子表格中的参数。 对于您的特定问题，您需要更改此代码（可能需要删除此代码并查看电子邮件是否显示在Lotus Notes中）：
'Send the e-mail. With noDocument .PostedDate = Now() .send 0, vaRecipient End With
如果删除上面的代码后，运行它并不显示在Lotus Notes中，则用以下代码replace上面的代码：
'Send the e-mail. Dim uiMemo As Object Dim ws As Object Set ws = CreateObject("Notes.NotesUIWorkspace") noDocument.Save True, True, False Set uiMemo = ws.EditDocument(True, noDocument)
让我知道这是怎么回事。