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")