Outlook宏开发求助：转发邮件并添加发件人别名至主题

修改后的完整宏代码 #

Sub ForwardWithSenderAlias(Item As Outlook.MailItem)
    Dim forwardMail As Outlook.MailItem
    Dim senderAlias As String
    Dim exchUser As Outlook.ExchangeUser
    
    ' 提取发件人别名
    If Item.SenderEmailType = "SMTP" Then
        ' 直接从SMTP邮箱拆分别名
        senderAlias = Split(Item.SenderEmailAddress, "@")(0)
    Else
        ' 处理Exchange内部用户，获取其SMTP地址
        Set exchUser = Item.Sender.GetExchangeUser()
        If Not exchUser Is Nothing Then
            senderAlias = Split(exchUser.PrimarySmtpAddress, "@")(0)
        Else
            ' 兜底：如果无法获取别名，显示默认文本
            senderAlias = "UnknownSender"
        End If
    End If
    
    ' 创建转发邮件
    Set forwardMail = Item.Forward
    With forwardMail
        ' 拼接主题：添加别名前缀
        .Subject = "On behalf of @" & senderAlias & " " & Item.Subject
        ' 添加收件人
        .Recipients.Add "backup@email.com"
        ' 保留原邮件HTML内容（如需纯文本替换为.Body = Item.Body）
        .HTMLBody = Item.HTMLBody
        ' 调试时可以打开.Display，正式使用换成.Send
        '.Display
        .Send
    End With
    
    ' 释放对象
    Set forwardMail = Nothing
    Set exchUser = Nothing
End Sub

关键修改点说明 #

• 发件人别名提取：
  • 区分SMTP外部邮箱和Exchange内部用户，覆盖所有场景
  • 用Split函数拆分邮箱地址，直接提取@前的部分
  • 增加兜底逻辑，避免因异常导致宏崩溃
• 代码健壮性：
  • 显式声明所有变量（模块顶部添加Option Explicit可进一步规范）
  • 手动释放对象，避免内存泄漏

修复宏无法运行的问题 #

1. 放置位置正确：
   按Alt+F11打开Outlook VBA编辑器，将代码粘贴到ThisOutlookSession模块中
2. 调整宏权限：
   • 点击Outlook左上角「文件」→「选项」→「信任中心」→「信任中心设置」→「宏设置」
   • 测试阶段选择「启用所有宏」，正式环境建议选「通知我签署的宏」并给宏签名
3. 正确运行方式：
   • 在收件箱中选中单封邮件
   • 点击「开发者」选项卡→「宏」，选择ForwardWithSenderAlias运行
   • 可将宏添加到快速访问工具栏，方便日常点击调用

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