VBA生成Outlook富文本邮件时使用附件占位符

在企业办公中，我们经常需要通过 Outlook 发送包含附件的邮件。为了实现自动化排版和插入操作，我们可以使用“占位符”来标记将来要插入附件的位置。本文将介绍如何通过 VBA 实现：在富文本格式邮件中自动查找指定占位符，并将其替换为一个可点击的附件链接（也可以基于此实现占位符文本替换，如果需要实现更加灵活的功能如表格、条件判断等，可能考虑使用Python包Doctpl）。

一、Outlook 邮件类型简介

Outlook 支持多种邮件格式：

• 纯文本格式（Plain Text）
  最基础的邮件格式，不支持任何样式、图片或超链接。

• HTML 格式（HTML Format）
  支持丰富的排版、图片、颜色、超链接等，是大多数用户的默认设置。

• 富文本格式（RTF / Rich Text Format）
  Outlook 特有的格式，使用 Word 编辑器作为邮件正文编辑引擎，支持高级格式和对象嵌入。

⚠️ 注意：本文介绍的功能仅适用于 富文本格式 的邮件，因为只有在这种模式下，Outlook 才会启用 Word 编辑器，从而允许我们精确控制插入位置并添加带显示名称的附件。

二、富文本邮件的优势

使用富文本邮件的好处包括：

• 支持复杂的排版和样式；
• 可以插入表格、图片、批注等元素；
• 允许通过 VBA 控制 Word 编辑器对象模型；
• 能够在特定位置插入附件并自定义显示名称（而不是只显示文件路径）；

三、功能说明：替换占位符为附件链接

我们要实现的目标是：

1. 在邮件正文中预先写好一个占位符，例如：[Attachment]
2. 运行 VBA 宏后，程序会：
   • 查找这个占位符；
   • 将其删除；
   • 在相同位置插入一个附件，并显示为自定义的文件名（如 Contract.pdf）；
3. 最终用户看到的是一个可点击的附件图标，而不再是占位符。

这样做的好处是：

• 邮件排版更整洁；
• 操作流程自动化；
• 提高邮件发送效率，尤其适用于模板化场景。

🔧 占位符命名建议

• 使用英文命名更好，例如 [Attachment] 或 [Report]；
• 使用中括号 [] 包裹，便于程序识别；
• 不建议使用中文或特殊字符，避免匹配失败；
• 确保占位符唯一，避免误替换；
• 尽量不要对占位符设置特殊格式，避免占位符匹配失败

---

四、完整 VBA 代码解析

以下是完整的 VBA 函数，用于完成上述功能：

Public Function ReplacePlaceholderWithAttachment( _
    ByVal mailItem As Object, _
    ByVal placeholder As String, _
    ByVal filePath As String _
) As Boolean

    Dim inspector As Object
    Dim wordDoc As Object
    Dim wordRange As Object
    Dim startPos As Long
    Dim fileName As String

    On Error GoTo ErrorHandler

    ReplacePlaceholderWithAttachment = False

    ' 检查是否为 MailItem
    If TypeName(mailItem) <> "MailItem" Then
        MsgBox "传入的对象不是 MailItem 类型。", vbCritical
        Exit Function
    End If

    ' 获取 Inspector 和 WordEditor
    Set inspector = mailItem.GetInspector
    Set wordDoc = inspector.WordEditor

    If wordDoc Is Nothing Then
        MsgBox "无法获取 WordEditor 对象。", vbCritical
        Exit Function
    End If

    ' 使用 Word Find 查找占位符
    With wordDoc.Content.Find
        .text = placeholder
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = False
        .Execute

        If .found Then
            Set wordRange = .Parent
            startPos = wordRange.Start + 1   ' Word 中 Start 是从 0 开始计数，Outlook 从 1 开始
        Else
            Debug.Print "未找到占位符: " & placeholder, vbExclamation
            Exit Function
        End If
    End With

    ' 删除占位符文本
    wordRange.text = " "

    ' 提取文件名作为显示名称
    If filePath <> "" And Dir(filePath) <> "" Then
        fileName = Mid(filePath, InStrRev(filePath, "\") + 1)

        ' 添加附件，使用 Position 参数指定插入位置
        mailItem.Attachments.Add filePath, olByValue, startPos, fileName

        ReplacePlaceholderWithAttachment = True
    Else
        Debug.Print "文件路径无效或不存在：" & filePath, vbCritical
        ReplacePlaceholderWithAttachment = False
    End If

    Exit Function

ErrorHandler:
    Debug.Print "发生错误：" & Err.Number & " - " & Err.Description, vbCritical
    ReplacePlaceholderWithAttachment = False

End Function```

五、使用示例
下面是一个调用该函数的简单例子：
```VBA
Sub TestReplace()
    Dim mail As Object
    Set mail = Application.ActiveInspector.CurrentItem

    Dim result As Boolean
    result = ReplacePlaceholderWithAttachment(mail, "[Attachment]", "C:\Temp\Contract.pdf")

    If result Then
        MsgBox "成功插入附件！", vbInformation
    Else
        MsgBox "插入附件失败，请检查路径或邮件状态。", vbCritical
    End If
End Sub ```