如何修改Excel宏以转发Outlook当前打开的邮件？

直接调整代码逻辑，替换原有的「选中邮件」处理方式为「当前打开邮件」，并实现转发给新收件人的需求，具体代码及修改说明如下：

修改后的完整代码 #

Private Sub CommandButton2_Click()
    Dim emailApplication As Object
    Dim originalEmail As Object
    Dim forwardEmail As Object
    
    Set emailApplication = CreateObject("Outlook.Application")
    
    ' 获取当前打开的邮件对象
    On Error Resume Next
    Set originalEmail = emailApplication.ActiveInspector.CurrentItem
    On Error GoTo 0
    
    ' 校验是否存在打开的邮件
    If originalEmail Is Nothing Then
        MsgBox "请先打开一封Outlook邮件再执行！", vbExclamation
        GoTo Cleanup
    End If
    
    ' 创建转发邮件
    Set forwardEmail = originalEmail.Forward
    
    ' 从Excel单元格读取并设置收件人、抄送
    forwardEmail.To = Range("A1") ' 替换为你存储收件人的实际单元格
    forwardEmail.CC = Range("R17")
    
    ' 设置邮件正文，如需保留原邮件内容可拼接原有正文
    forwardEmail.Body = Range("B4") & vbCrLf & vbCrLf & forwardEmail.Body
    ' 若不需要原邮件内容，直接使用：forwardEmail.Body = Range("B4")
    
    ' 显示转发邮件
    forwardEmail.Display
    
Cleanup:
    ' 释放对象
    Set forwardEmail = Nothing
    Set originalEmail = Nothing
    Set emailApplication = Nothing
End Sub

关键修改点说明 #

• 目标对象切换：把原代码中获取选中邮件的emailApplication.ActiveExplorer.Selection.Item(1)替换为emailApplication.ActiveInspector.CurrentItem，实现获取当前打开的邮件而非选中邮件的逻辑
• 操作类型变更：用.Forward方法创建转发邮件，替代原有的.ReplyAll，匹配你要求的「转发给新收件人」需求
• 错误防护：添加空值校验，当没有打开的邮件时弹出提示，避免宏运行报错
• 正文灵活设置：提供两种正文配置方式，可选择仅使用Excel单元格内容，或把Excel内容前置并保留原邮件的转发内容

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