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项目值，它是＆＃34; 3＆＃34;如果是富文本，＆＃34; 2＆＃34;如果它是HTML或图像文件，＆＃34; 1＆＃34;如果是纯文本。您的代码中的解决方案将根据正在使用的解决方案而有所不同，并且在创建富文本消息时应对选项2并不容易。

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

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

1 个答案: