VBA转发邮件：如何保留原邮件(origEmail)的附件？

你需要在现有代码中添加遍历原邮件附件并复制到新邮件的逻辑，以下是修改后的完整代码：

Sub forwardemailwithattachment()
    Dim origEmail As MailItem
    Dim forwardEmail As MailItem
    Dim att As Attachment ' 新增附件对象变量

    Set origEmail = Application.ActiveWindow.Selection.Item(1)
    Set forwardEmail = Application.CreateItemFromTemplate("insert here template location")

    forwardEmail.To = "insert here email address of recipient"
    forwardEmail.Subject = forwardEmail.Subject & origEmail.Subject
    forwardEmail.HTMLBody = forwardEmail.HTMLBody & origEmail.Forward.HTMLBody

    ' 核心：遍历原邮件所有附件，添加到新邮件
    For Each att In origEmail.Attachments
        ' 使用olByValue确保附件以独立文件形式添加，而非嵌入对象
        forwardEmail.Attachments.Add att.FileName, olByValue, , att.DisplayName
    Next att

    forwardEmail.Display
End Sub

关键说明： #

• 新增Dim att As Attachment变量用于遍历原邮件的附件集合
• 通过For Each att In origEmail.Attachments循环处理每个附件
• Attachments.Add方法的第二个参数olByValue（值为1）指定附件作为独立文件添加，避免将嵌入的图片等对象误处理
• 保留原附件的文件名和显示名称，保证和原邮件一致

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