如何在Lotus Notes邮件正文中添加带格式的Excel单元格区域

原代码直接将单元格区域赋值给MailDoc.body的方式仅能传递纯文本内容，无法保留单元格的颜色、边框等格式。要实现带格式嵌入，需将Excel区域转换为HTML格式，再通过Lotus Notes的富文本对象渲染到邮件正文中。

修改后的完整代码 #

Sub SendEmailWithFormattedRange()
    Dim TodayDate As Date
    Dim x As Integer, A As Integer
    Dim UserName As String
    Dim MailDbName As String, msgboxtitle As String
    Dim Recipient As Variant
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim stSignature As String
    Dim Sent As String, EmailTo As String
    Dim RecipientEmail As String, Subject As String
    Dim rng As Range
    Dim rtItem As Object ' NotesRichTextItem
    Dim htmlContent As String
    Dim tempFile As String
    
    ' 读取邮件参数和目标区域
    RecipientEmail = Worksheets("Email").Range("B1").Value
    EmailTo = Worksheets("Email").Range("C3").Value
    Subject = Worksheets("Email").Range("B2").Value
    Set rng = Worksheets("Email").Range("B3:C10")
    
    ' 将Excel区域转换为HTML格式（依赖Word对象）
    tempFile = Environ("TEMP") & "\temp_email_range.html"
    rng.Copy
    With CreateObject("Word.Application")
        .Documents.Add
        .Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine, DisplayAsIcon:=False
        .ActiveDocument.SaveAs2 Filename:=tempFile, FileFormat:=wdFormatHTML
        .ActiveDocument.Close SaveChanges:=False
        .Quit
    End With
    ' 读取HTML内容
    Open tempFile For Input As #1
    htmlContent = Input$(LOF(1), 1)
    Close #1
    Kill tempFile ' 清理临时文件
    
    ' 连接Lotus Notes会话
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GetDatabase("", MailDbName)
    
    If Not Maildb.IsOpen Then
        Maildb.OPENMAIL
    End If
    
    ' 创建邮件文档
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.SendTo = RecipientEmail
    MailDoc.Subject = Subject
    MailDoc.SaveMessageOnSend = True
    MailDoc.PostedDate = Now()
    
    ' 将HTML内容插入富文本正文
    Set rtItem = MailDoc.CreateRichTextItem("Body")
    rtItem.AppendRTItem rtItem.EmbedObject(1454, "", htmlContent, "HTML") ' 1454对应EMBED_TYPE_HTML常量
    
    ' 可选：添加邮件签名（如需启用请取消注释）
    ' stSignature = Session.GetEnvironmentString("MailSignature", True)
    ' If stSignature <> "" Then
    '     rtItem.AddNewLine(2)
    '     rtItem.AppendText stSignature
    ' End If
    
    ' 发送邮件
    On Error GoTo errorhandler1
    MailDoc.Send 0, RecipientEmail
    
cleanup:
    ' 释放对象
    Set rtItem = Nothing
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    Exit Sub
    
errorhandler1:
    MsgBox "邮件发送失败：" & Err.Description, vbCritical
    GoTo cleanup
End Sub

关键修改说明 #

1. Excel区域转HTML
   利用Word的PasteSpecial功能将复制的单元格区域转换为HTML格式，可精准保留单元格的颜色、边框、字体等样式，再读取HTML文件内容作为邮件正文的数据源。

   • 若不想依赖Word，可替换为Excel原生的PublishObjects方法生成HTML：

     With rng
         ActiveWorkbook.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=tempFile, _
             Sheet:=.Parent.Name, _
             Source:=.Address, _
             HtmlType:=xlHtmlStatic).Publish (True)
     End With
     

2. Lotus Notes富文本处理
   创建NotesRichTextItem对象替代原生的MailDoc.Body，通过EmbedObject方法导入HTML内容，Lotus Notes会自动解析HTML并渲染为带格式的富文本。

3. 资源清理
   添加临时文件删除逻辑和对象释放流程，避免残留文件和内存泄漏。

内容的提问来源于stack exchange，提问作者Nissan