VBA：通过 IBM Notes 发送电子邮件，添加签名？

Question

我有以下从 Excel 运行的 vba 代码。它会向一个范围内的收件人列表发送一封电子邮件。

Sub Send_Email()

Dim answer As Integer
    answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
    If answer = vbNo Then
    Exit Sub

    Else

Dim rnBody As Range
Dim Data As DataObject

Set rnBody = Worksheets(1).Range("N3")
rnBody.Copy

Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row  'Finds the last used row

j = 18



'Start a session of Lotus Notes
Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Call Session.Initialize
'Open the Mail Database of your Lotus Notes

user = Session.UserName
usersig = Session.CommonUserName
server = Session.GetEnvironmentString("MailServer", True)
mailfile = Session.GetEnvironmentString("MailFile", True)

Set Maildb = Session.GetDatabase(server, mailfile)
If Not Maildb.IsOpen = True Then Call Maildb.Open

With ThisWorkbook.Worksheets(1)

For i = 18 To LastRow

'Create the Mail Document
Session.ConvertMime = False ' Do not convert MIME to rich text

Set MailDoc = Maildb.CREATEDOCUMENT
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set From
Call MailDoc.ReplaceItemValue("Principal", "Food.Specials@Lidl.co.uk")
Call MailDoc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call MailDoc.ReplaceItemValue("DisplaySent", "Food Specials")
Call MailDoc.ReplaceItemValue("iNetFrom", "Food.Specials@Lidl.co.uk")
Call MailDoc.ReplaceItemValue("iNetPrincipal", "Food.Specials@Lidl.co.uk")


'Set the Recipient of the mail
Call MailDoc.ReplaceItemValue("SendTo", Range("Q" & i).value)
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials@lidl.co.uk")

'Set subject of the mail
Call MailDoc.ReplaceItemValue("Subject", "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required")



'Create and set the Body content of the mail
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
If Range("I10").value <> "" Then
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
    & "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
    & "Please can you confirm within 24 hours." & vbNewLine & vbNewLine _
    & Range("I10").value & vbNewLine)
Else
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
    & "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
    & "Please can you confirm within 24 hours." & vbNewLine)
End If

'Embed Excel Sheet Range
Set Data = New DataObject
Data.GetFromClipboard

Call Body.ADDNEWLINE(2)
Call Body.EmbedObject(1454, "", Range("F" & i).value, "Attachment")

'create an attachment (optional)

Call Body.ADDNEWLINE(3)
Call Body.APPENDTEXT(Data.GetText)


'create an attachment (optional)
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT(Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0))

'Example to save the message (optional) in Sent items
    MailDoc.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
    Call MailDoc.ReplaceItemValue("PostedDate", Now())
    Call MailDoc.Send(False)

    Set MailDoc = Nothing


    j = j + 1

               Next i
               End With




'Clean Up the Object variables - Recover memory
    Set Maildb = Nothing
     Set Body = Nothing
    Set Session = Nothing

    Application.CutCopyMode = False


MsgBox "Success!" & vbNewLine & "Announcements have been sent."

End If

End Sub

代码半有效。电子邮件发送正常。

但是，我希望能够将默认签名添加到我的电子邮件底部。我正在尝试使用此行来执行此操作，但它没有添加任何签名。

'create an attachment (optional)
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT(Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)) 

我的签名包含一张图片，我想知道这是否会因为我的电子邮件不是 html 而无法通过签名？

在这种情况下，我如何将这封电子邮件更改为 html？ 请问有人可以告诉我我做错了什么吗？

Answer 1

你的怀疑是正确的。这将不起作用，因为您正在创建 Notes 富文本电子邮件 - 但解决方案不一定要切换到创建 MIME/HTML 消息。 NotesRichTextItem 类的AppendText 方法只能处理文本，但如果Notes 签名是富文本格式，它实际上是您应该使用的Signature_Rich 项，而不是Signature 项，您应该使用AppendRTItem 方法而不是 AppendText 方法。

不过，事实是，对于两种不同的邮件格式和在用户个人资料中管理签名的方式有几种不同的选项，对于您可能遇到的所有不同情况，这是一个非常重要的问题处理。您确实必须查看 SignatureOption 项的值，如果是富文本，则为“3”，如果是 HTML 或图像文件，则为“2”，如果是纯文本，则为“1”。您的代码中的解决方案会有所不同，具体取决于所使用的解决方案，并且在创建富文本消息的同时处理选项 2 并不容易。

如果您不想使用 Notes 富文本，您可能需要查看 answer to this previous question 以获取构建 MIME 消息的示例。虽然我没有审查 this blog post 中的代码，但它显示了附加签名 - 看起来它假设签名在文件中，而不是检查 SignatureOptions 项。