VBA调用Lotus Notes：MIME与富文本共存时附件发送异常

问题背景 #

我编写了一段VBA代码用于通过Lotus Notes发送邮件，邮件包含MIME HTML正文和PDF附件，但出现以下异常：

• 邮件保存时，HTML正文和顶部的附件均正常显示
• 外发给外部收件人后，PDF附件消失
• 注释掉代码中的HTML MIME部分，附件可正常外发并显示在顶部

想了解两者互相影响的原因，以及如何实现邮件保存与外发内容一致。

原VBA代码 #

Public Sub COM_Email_Send()

Dim NSession As Object
Dim NMailDb As Object
Dim NDocument As Object
Dim NBody As Object
Dim NChild As Object
Dim Nstream As Object
Dim RichTextHeader As Object

Dim i As Long
Dim Row As Long
Dim Recipient As String
Dim File As String
Dim attachmentFile As String
Dim Data As String
Dim AttachedOb As Object
Dim EmbedOb As Object
Dim NHeader As Object
Dim strFileType As Variant
Dim MIMEDoc As Object

Set NSession = CreateObject("Lotus.NotesSession")
Call NSession.Initialize("password")

Set NMailDb = NSession.GetDatabase("directory", "server")
If Not NMailDb.IsOpen = True Then
Call NMailDb.Open
End If

    Row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To Row
    
    Recipient = Worksheets("Sheet1").Range("B" & i)
    
    If Recipient <> "" Then
    
    
    File = Worksheets("Sheet1").Range("A" & i).Value
    
    attachmentFile = "Directory" & File
    
    Data = Format(Now(), "dd/mm/yyyy")


    Set NDocument = NMailDb.CreateDocument
    Set Nstream = NSession.CreateStream
    
    
    Call NDocument.replaceitemvalue("Form", "Memo")
    Call NDocument.replaceitemvalue("SendTo", Recipient)
    Call NDocument.replaceitemvalue("Subject", "Please see your clearance documents attached " & Data)
    Call NDocument.replaceitemvalue("Sender", "noreply@test.com")
    
    If attachmentFile <> "" Then
    Set AttachedOb = NDocument.Createrichtextitem("attachmentFile")
    Set EmbedOb = AttachedOb.embedobject(1454, "", attachmentFile, "")
    End If
    
    Call Nstream.Open("Directory\HTML BODY.htm")
    Set NBody = NDocument.CreateMIMEEntity '("memo")
    Set RichTextHeader = NBody.CreateHeader("Content-Type")
    Call RichTextHeader.SetHeaderVal("multipart/mixed")
    Set MIMEDoc = NBody.CreateChildEntity()
    
    Call MIMEDoc.SetContentFromBytes(Nstream, "text/html", ENC_IDENTITY_BINARY)
    Call Nstream.Close
    
    
    
    NDocument.savemessageonsend = True
    
    Call NDocument.replaceitemvalue("PostedDate", Now())
    Call NDocument.Send(False)
    

    Set NDocument = Nothing
    Set Nstream = Nothing
    
    End If
    Next i
    
End Sub

按照指导修改后的代码及新问题 #

修改后尝试统一用MIME处理正文和附件，但出现新问题：PDF附件显示在HTML正文下方，但附件内容为空。

Public Sub COM_Email_Send()

Dim NSession As Object
Dim NMailDb As Object
Dim NDocument As Object
Dim NBody As Object
Dim NChild As Object
Dim Nstream As Object
Dim Header As Object
Dim HeaderChild As Object


Dim i As Long
Dim Row As Long
Dim Recipient As String
Dim File As String
Dim attachmentFile As String
Dim Data As String
Dim AttachedOb As Object
Dim EmbedOb As Object
Dim NHeader As Object
Dim strFileType As Variant
Dim MIMEDoc As Object

Set NSession = CreateObject("Lotus.NotesSession")
Call NSession.Initialize("password")

Set NMailDb = NSession.GetDatabase("server directory", "server")
If Not NMailDb.IsOpen = True Then
Call NMailDb.Open
End If

    Row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To Row
    
    Recipient = Worksheets("Sheet1").Range("B" & i)
    
    If Recipient <> "" Then
    
    
    File = Worksheets("Sheet1").Range("A" & i).Value
    
    attachmentFile = "Directory" & File
    
    Data = Format(Now(), "dd/mm/yyyy")


    Set NDocument = NMailDb.CreateDocument
    Set Nstream = NSession.CreateStream
    
    
    Call NDocument.replaceitemvalue("Form", "Memo")
    Call NDocument.replaceitemvalue("SendTo", Recipient)
    Call NDocument.replaceitemvalue("Subject", "Please see your clearance documents attached " & Data)
    Call NDocument.replaceitemvalue("Sender", "noreply@test.com")
    
    Set NBody = NDocument.CreateMIMEEntity
    
    Call Nstream.Open("Directory")
    
    Set MIMEDoc = NBody.CreateChildEntity()
    Set Header = MIMEDoc.Createheader("Content-Type")
    Call Header.SetHeaderVal("multipart/mixed")
    
    Call MIMEDoc.SetContentFromBytes(Nstream, "text/html", ENC_IDENTITY_BINARY)
    Call Nstream.Close
    Call Nstream.Truncate
    
    
    Call Nstream.Open("Directory" & File)
    Set NChild = NBody.CreateChildEntity()
    
    Set HeaderChild = NChild.Createheader("Content-Type")
    Call HeaderChild.SetHeaderVal("multipart/mixed")
    
    Set HeaderChild = NChild.Createheader("Content-Disposition")
    Call HeaderChild.SetHeaderVal("attachment; filename=" & File)
    
    Set HeaderChild = NChild.Createheader("Content-ID")
    Call HeaderChild.SetHeaderVal(File)
    
    Set HeaderChild = NChild.Createheader("Content-Transfer-Encoding")
    Call HeaderChild.SetHeaderVal(base64)
    
    Call NChild.SetContentFromBytes(Nstream, "application/pdf", ENC_BASE64)
    
    Call Nstream.Close
    
    
    NDocument.savemessageonsend = True
    
    Call NDocument.replaceitemvalue("PostedDate", Now())
    
    
    Call NDocument.Send(False)
    

    Set NDocument = Nothing
    Set Nstream = Nothing
    
    End If
    Next i
    
End Sub

问题原因及解决方案 #

原代码问题根源 #

原代码同时混用富文本附件（RichTextItem）和MIME实体两种邮件构建方式：

• Lotus Notes外发邮件时，若同时存在MIME实体和富文本项，会优先采用MIME格式，但原代码未将附件纳入MIME结构，导致外部收件人仅能看到MIME的HTML正文，富文本附件被忽略。
• 本地保存时Notes客户端会兼容两种格式显示，因此看起来正常，但外发时的MIME转换会丢失未纳入MIME结构的富文本附件。

修改后代码的问题 #

修改后的代码存在多个关键错误：

1. HTML文件路径错误：Call Nstream.Open("Directory") 未指向具体的HTML文件，导致正文内容读取失败。
2. 附件Content-Type设置错误：单个PDF附件应设置为application/pdf，而非容器类型的multipart/mixed。
3. base64未定义：需使用Notes常量ENC_BASE64或其对应数值3。
4. MIME层级错误：顶级MIME实体应设置为multipart/mixed，正文和附件作为子实体存在，而非在第一个子实体中再设置multipart/mixed。

正确代码实现 #

以下是修正后的代码，统一用MIME结构处理正文和附件，确保外发与保存内容一致：

Public Sub COM_Email_Send()
    Dim NSession As Object
    Dim NMailDb As Object
    Dim NDocument As Object
    Dim NBody As Object
    Dim MIMEBodyChild As Object
    Dim MIMEAttachChild As Object
    Dim Nstream As Object
    Dim Header As Object
    Dim i As Long
    Dim Row As Long
    Dim Recipient As String
    Dim File As String
    Dim attachmentFile As String
    Dim htmlFilePath As String
    Dim Data As String
    
    ' 初始化Notes会话
    Set NSession = CreateObject("Lotus.NotesSession")
    Call NSession.Initialize("password")
    
    ' 打开邮件数据库
    Set NMailDb = NSession.GetDatabase("server directory", "server")
    If Not NMailDb.IsOpen Then Call NMailDb.Open
    
    Row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To Row
        Recipient = Worksheets("Sheet1").Range("B" & i)
        If Recipient <> "" Then
            File = Worksheets("Sheet1").Range("A" & i).Value
            attachmentFile = "Directory" & File
            htmlFilePath = "Directory\HTML BODY.htm" ' 修正HTML文件路径
            Data = Format(Now(), "dd/mm/yyyy")
            
            Set NDocument = NMailDb.CreateDocument
            Set Nstream = NSession.CreateStream
            
            ' 设置邮件基础属性
            Call NDocument.ReplaceItemValue("Form", "Memo")
            Call NDocument.ReplaceItemValue("SendTo", Recipient)
            Call NDocument.ReplaceItemValue("Subject", "Please see your clearance documents attached " & Data)
            Call NDocument.ReplaceItemValue("Sender", "noreply@test.com")
            
            ' 创建顶级MIME实体，设置为multipart/mixed
            Set NBody = NDocument.CreateMIMEEntity
            Set Header = NBody.CreateHeader("Content-Type")
            Call Header.SetHeaderVal("multipart/mixed; boundary=" & NSession.CreateMIMEBoundary)
            
            ' 添加HTML正文子实体
            Set MIMEBodyChild = NBody.CreateChildEntity()
            Set Header = MIMEBodyChild.CreateHeader("Content-Type")
            Call Header.SetHeaderVal("text/html; charset=utf-8")
            Set Header = MIMEBodyChild.CreateHeader("Content-Transfer-Encoding")
            Call Header.SetHeaderVal("quoted-printable")
            
            If Nstream.Open(htmlFilePath) Then
                Call MIMEBodyChild.SetContentFromBytes(Nstream, "text/html", ENC_QUOTED_PRINTABLE)
                Call Nstream.Close
            End If
            
            ' 添加PDF附件子实体
            If attachmentFile <> "" And Dir(attachmentFile) <> "" Then
                Set MIMEAttachChild = NBody.CreateChildEntity()
                Set Header = MIMEAttachChild.CreateHeader("Content-Type")
                Call Header.SetHeaderVal("application/pdf; name=" & Chr(34) & File & Chr(34)) ' 引号包裹文件名避免特殊字符问题
                Set Header = MIMEAttachChild.CreateHeader("Content-Disposition")
                Call Header.SetHeaderVal("attachment; filename=" & Chr(34) & File & Chr(34))
                Set Header = MIMEAttachChild.CreateHeader("Content-Transfer-Encoding")
                Call Header.SetHeaderVal("base64")
                
                If Nstream.Open(attachmentFile) Then
                    Call MIMEAttachChild.SetContentFromBytes(Nstream, "application/pdf", ENC_BASE64)
                    Call Nstream.Close
                End If
            End If
            
            ' 保存并发送邮件
            NDocument.SaveMessageOnSend = True
            Call NDocument.ReplaceItemValue("PostedDate", Now())
            Call NDocument.Send(False)
            
            ' 释放对象
            Set NDocument = Nothing
            Set Nstream = Nothing
            Set NBody = Nothing
            Set MIMEBodyChild = Nothing
            Set MIMEAttachChild = Nothing
        End If
    Next i
    
    ' 释放全局对象
    Set NMailDb = Nothing
    Set NSession = Nothing
End Sub

关键修正点说明 #

1. 统一MIME结构：所有内容（正文+附件）均纳入顶级multipart/mixed的MIME实体下，避免格式冲突。
2. 准确文件路径：确保HTML和PDF文件的路径指向正确的文件。
3. 规范MIME头设置：
   • 正文设置text/html; charset=utf-8保证编码正确
   • 附件用application/pdf标识文件类型，文件名用引号包裹避免空格或特殊字符问题
   • 传输编码分别使用quoted-printable（适合文本）和base64（适合二进制文件）
4. 对象释放：添加完整的对象释放逻辑，避免内存泄漏。

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