Php 无法在excel中手动发送Lotus Notes电子邮件
我尝试使用宏向客户发送Lotus Notes电子邮件,我可以自动发送,但如果在发送之前我想添加任何内容,那么我想将其设置为手动模式,这样我就可以首先查看电子邮件,并可能在发送前进行一些更改,所以我的问题是我应该如何修改它?我有一些方法,但它们不起作用 然后,我将使用自动发送功能发布我的全部代码:Php 无法在excel中手动发送Lotus Notes电子邮件,php,excel,email,Php,Excel,Email,我尝试使用宏向客户发送Lotus Notes电子邮件,我可以自动发送,但如果在发送之前我想添加任何内容,那么我想将其设置为手动模式,这样我就可以首先查看电子邮件,并可能在发送前进行一些更改,所以我的问题是我应该如何修改它?我有一些方法,但它们不起作用 然后,我将使用自动发送功能发布我的全部代码: Sub Send_Unformatted_Rangedata(i As Integer) Dim noSession As Object, noDatabase As Object, noDocumen
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
我的LotusNotes要发送或显示的代码如下所示,您需要为代码修改它。对于我来说,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中):
如果在删除上述代码后运行该代码,但它没有显示在Lotus Notes中,请使用以下代码替换上述代码:
'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)
告诉我这是怎么回事。我收到了
MailDoc的错误消息。请保存True,True,False
,我可以知道应该如何修改它吗?因为我已经觉得有点失落了:(您好,您的activecell基于哪个单元格?正如我提到的,您需要修改代码,即您需要将MailDoc更改为noDocument。我的activecell基于我的电子表格中的一个单元格,同样,您需要更改用于发送/显示的参数。我将编辑我的答案以帮助您,如果将来您需要的话在发送和显示之间进行选择的选项您可以将代码编辑为我的初始答案。谢谢,因为我没有发送/显示单元格,而且我不太熟悉excel函数,所以我很难做到这一点。
'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)