如何通过VBA将Outlook草稿文件夹中的.msg文件附加到另一封邮件？

可以直接通过Outlook对象模型引用草稿文件夹中的邮件Item，无需SaveAs方法就能将其作为附件添加到新邮件中，具体实现如下：

核心思路 #

直接定位到Outlook草稿文件夹，找到目标草稿邮件对象，然后通过Attachments.Add方法将该邮件对象作为附件附加到新邮件，指定附件类型为olItemAttachment（常量值5），即可实现将整封草稿邮件以.msg格式附加的效果。

VBA代码示例 #

Sub AttachDraftToNewEmail()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim draftFolder As Outlook.Folder
    Dim targetDraft As Outlook.MailItem
    Dim newEmail As Outlook.MailItem
    
    '初始化Outlook对象
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    '获取默认草稿文件夹
    Set draftFolder = olNamespace.GetDefaultFolder(olFolderDrafts)
    
    '精准定位目标草稿邮件——请根据实际需求修改筛选条件
    '示例：匹配主题包含"待附加草稿"的最新邮件
    For Each targetDraft In draftFolder.Items
        If targetDraft.Subject Like "*待附加草稿*" Then
            Exit For
        End If
    Next targetDraft
    
    If Not targetDraft Is Nothing Then
        '创建新邮件
        Set newEmail = olApp.CreateItem(olMailItem)
        '将草稿邮件作为附件添加，指定类型为olItemAttachment
        newEmail.Attachments.Add targetDraft, olItemAttachment
        '设置新邮件的主题、收件人等属性（按需修改）
        newEmail.Subject = "包含草稿附件的新邮件"
        newEmail.Display '显示邮件，如需直接发送可替换为newEmail.Send
    Else
        MsgBox "未找到目标草稿邮件！"
    End If
    
    '释放对象
    Set newEmail = Nothing
    Set targetDraft = Nothing
    Set draftFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub

关键说明 #

• 无需使用SaveAs或修改注册表，完全基于Outlook对象模型实现，符合公司政策限制。
• 筛选目标草稿时，建议结合主题、创建时间、发件人等多维度条件，确保精准匹配到需要的草稿（比如可以按targetDraft.CreationTime排序后取最新的符合主题的邮件）。
• 初始邮件中的可变附件会被完整包含在草稿邮件中，附加到新邮件后，收件人打开附件就能看到包含可变附件的原始邮件内容。

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