Outlook VBA宏开发需求：根据主题或收件人姓氏自动添加指定附件

实现逻辑 #

1. 触发时机：发送邮件前自动执行（也可改为手动运行，代码内有说明）
2. 优先匹配主题：用正则提取XYZ-开头的编号，拼接成[编号]_TEMPLATE文件名，检查存在后添加附件
3. 主题匹配失败时：提取收件人姓氏，到指定共享文件夹查找对应文件并添加

完整代码 #

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim mail As MailItem
    Dim regEx As Object
    Dim matches As Object
    Dim templatePath As String
    Dim fileName As String
    Dim recipient As Recipient
    Dim lastName As String
    
    ' 替换为你的实际共享文件夹路径
    templatePath = "\\ServerName\SharedFolder\Templates\"
    
    ' 仅处理邮件对象
    If TypeName(Item) <> "MailItem" Then Exit Sub
    Set mail = Item
    
    ' --------------------------
    ' 第一步：尝试通过主题匹配附件
    ' --------------------------
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Pattern = "XYZ-\d+" ' 匹配XYZ-开头+数字的格式，可按需调整
        .Global = False
        .IgnoreCase = False
    End With
    
    Set matches = regEx.Execute(mail.Subject)
    If matches.Count > 0 Then
        fileName = matches(0).Value & "_TEMPLATE.docx" ' 按需修改文件后缀
        If Dir(templatePath & fileName) <> "" Then
            mail.Attachments.Add templatePath & fileName
            MsgBox "已通过主题匹配添加附件：" & fileName, vbInformation
            GoTo Cleanup ' 匹配成功，跳过后续步骤
        End If
    End If
    
    ' --------------------------
    ' 第二步：主题匹配失败，尝试通过收件人姓氏匹配
    ' --------------------------
    If mail.Recipients.Count > 0 Then
        Set recipient = mail.Recipients(1)
        ' 提取姓氏（适配"张三"或"John Doe"格式，按需调整）
        lastName = Split(recipient.Name, " ")(UBound(Split(recipient.Name, " ")))
        fileName = lastName & "_TEMPLATE.docx" ' 按需修改文件名规则
        If Dir(templatePath & fileName) <> "" Then
            mail.Attachments.Add templatePath & fileName
            MsgBox "已通过收件人姓氏添加附件：" & fileName, vbInformation
        Else
            MsgBox "未找到匹配的附件文件", vbExclamation
        End If
    End If

Cleanup:
    Set mail = Nothing
    Set regEx = Nothing
    Set matches = Nothing
    Set recipient = Nothing
End Sub

关键部分说明 #

• 主题匹配规则：正则表达式XYZ-\d+可直接修改，比如要匹配字母数字混合编号，改成XYZ-[A-Z0-9]+即可
• 收件人姓氏提取：默认取第一个收件人姓名的最后部分作为姓氏，如果是中文全名（如“张三”），可直接把lastName = Split(...)改成lastName = recipient.Name
• 手动运行修改：如果不需要自动触发，可将代码改为普通宏——去掉Private Sub Application_ItemSend，改成Sub AddTemplateAttachment()，然后在Outlook中手动运行
• 路径与格式：必须替换templatePath为实际共享路径，文件后缀（.docx）可按需改为.pdf、.xlsx等

注意事项 #

1. 启用宏：在Outlook「文件」→「选项」→「信任中心」→「信任中心设置」→「宏设置」中选择「启用所有宏」（测试后可调整为更安全的设置）
2. 测试验证：先创建测试邮件触发宏，避免影响正式邮件
3. 错误处理：如需更严谨的容错，可添加On Error Resume Next或On Error GoTo语句

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