VBA：通過IBM Notes發送電子郵件，添加簽名？

Question

我有以下vba代碼，它從Excel運行。 它會向一個范圍內的收件人列表發送電子郵件。

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富文本，可能需要查看上一個問題的答案，以獲取構建MIME消息的示例。 雖然我沒有審查這篇博文中的代碼，但它顯示了附加簽名 - 看起來它假設簽名是在文件中，而不是檢查SignatureOptions項。