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

Question

I have the following vba code, which runs from Excel. It sends an email to a list of recipients in a range.

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

The code semi works. Emails are sent fine.

However, i want to be able to add the default signature to the bottom of my email. I am trying to do this using this line but its not adding any signature.

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

My signature contains an image, and i'm wondering if this won't pull through the signature because my email isn't html?

In which case then, how could i change this email to html? Please can someone show me what i am doing wrong?

Answer 1

Your suspicion is correct. This won't work since you're creating a Notes rich text email message - but the solution is not necessarily switching to creating a MIME/HTML message. The NotesRichTextItem class's AppendText method can only handle text, but if the Notes signature is in rich text format, it's actually the Signature_Rich item that you should be working with, not the Signature item, and you should be using the AppendRTItem method instead of the AppendText method.

The truth is, though, that with two different mail formats and several different options for the way the signature is managed in the user's profile, this is a non-trivial problem to handle for all of the different cases that you might have to handle. You really have to look at the SignatureOption item value, which is "3" if it is rich text, "2" if it's an HTML or image file, and "1" if it is plain text. The solution in your code is going to be different depending on which one is being used, and coping with option 2 while creating a rich text message isn't going to be easy.

You might want to check out the answer to this previous question for an example of building a MIME message if you want to get away from using Notes rich text. And while I haven't vetted the code in this blog post , it shows appending a signature - it looks like it is assuming that the signature is in a file rather than checking the SignatureOptions item.