Return 收据 Lotus Notes
Return Receipt Lotus Notes
我有在 Lotus Notes 上发送电子邮件的工作代码。
我想知道是否收到了电子邮件。
我试过了.Document.ReturnReceipt = "1"
。
Sub Enviaremailnotes()
Dim Notes As Object
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim EmbedObj As Object
Dim i As Long
Set Notes = CreateObject("Notes.NotesSession")
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GetDataBase(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
'Copy the email address from cell C19 into the TO: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon.
'Please change your current sheet's name from Sheet1 to your sheet's name
Recipient = Sheets("Plan1").Range("A2").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
'Copy the email address from cellC C20 into the CC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Plan1").Range("B2").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
'Copy the subject from cell C22 into the SUBJECT: field in Lotus Notes
Subject1 = "Carta AST/DELOG/AFRMM" & " " & Cells(2, 3) & "/2021 - " & " " & Cells(2, 4)
Call UIdoc.FieldSetText("Subject", Subject1)
'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
'You must set the last cell C47 to one cell below the range you wish to copy.
Call UIdoc.GotoField("Body")
body1 = Sheets("Plan1").Range("E16").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E17").Value ' Space
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E18").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E19").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E20").Value ' Space
Call UIdoc.InsertText(body1)
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
With UIdoc
.Document.ReturnReceipt = "1"
.Document.SaveOptions = "1"
.Document.MailOptions = "1"
.Close
End With
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
不要使用 UI 类 生成电子邮件,而是尝试重写代码以使用后端 类。
早在 2011 年,我就在我的博客上发布了 a Lotusscript class,您可以在其中了解如何做到这一点。将其转换为 VBA 并在 Excel 中使用应该不难。
添加一行来设置 ReturnReceipt 标志将是微不足道的:
Call maildoc.ReplaceItemValue("ReturnReceipt", "1")
我有在 Lotus Notes 上发送电子邮件的工作代码。
我想知道是否收到了电子邮件。
我试过了.Document.ReturnReceipt = "1"
。
Sub Enviaremailnotes()
Dim Notes As Object
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim EmbedObj As Object
Dim i As Long
Set Notes = CreateObject("Notes.NotesSession")
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GetDataBase(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
'Copy the email address from cell C19 into the TO: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon.
'Please change your current sheet's name from Sheet1 to your sheet's name
Recipient = Sheets("Plan1").Range("A2").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
'Copy the email address from cellC C20 into the CC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Plan1").Range("B2").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
'Copy the subject from cell C22 into the SUBJECT: field in Lotus Notes
Subject1 = "Carta AST/DELOG/AFRMM" & " " & Cells(2, 3) & "/2021 - " & " " & Cells(2, 4)
Call UIdoc.FieldSetText("Subject", Subject1)
'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
'You must set the last cell C47 to one cell below the range you wish to copy.
Call UIdoc.GotoField("Body")
body1 = Sheets("Plan1").Range("E16").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E17").Value ' Space
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E18").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E19").Value
body1 = body1 & vbCrLf & Sheets("Plan1").Range("E20").Value ' Space
Call UIdoc.InsertText(body1)
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
With UIdoc
.Document.ReturnReceipt = "1"
.Document.SaveOptions = "1"
.Document.MailOptions = "1"
.Close
End With
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
不要使用 UI 类 生成电子邮件,而是尝试重写代码以使用后端 类。 早在 2011 年,我就在我的博客上发布了 a Lotusscript class,您可以在其中了解如何做到这一点。将其转换为 VBA 并在 Excel 中使用应该不难。 添加一行来设置 ReturnReceipt 标志将是微不足道的:
Call maildoc.ReplaceItemValue("ReturnReceipt", "1")