VBA将电子邮件作为.MSG复制到新电子邮件

我对使用VBA还不熟悉，我四处寻找，试图找到一个解决方案。我不知道这是否可能，但我将尝试看看是否有人能想出任何想法

因此，当您进入Outlook并右键单击电子邮件时，可以选择“复制”。创建新电子邮件并粘贴电子邮件时，复制的电子邮件将作为.msg作为附加文件附加

我试图复制这个过程。现在我的过程是

查找电子邮件

InStr(olMail.Subject, "SUBJECT") <> 0

复制正文并将文本设置为strPaste

Buf.SetText(OlMail.Body)
Buf.PutInClipBoard 
strPaste = Buf.GetText(1)

创建新电子邮件

MailItem = OlApp.CreateItem(0)

膏体

.Body = strPaste

这是可行的，但它并不干净，因为邮件中还有其他内容，因此最好将复制的电子邮件附加到电子邮件中，而不是复制正文

我也不想将电子邮件另存为.msg，然后附加它，因为其他人将使用宏，为每个人更改电子邮件的保存路径将非常繁琐

任何建议都很好

因此，当您进入Outlook并右键单击电子邮件时，可以选择“复制”。创建新电子邮件并粘贴电子邮件时，复制的电子邮件将作为.msg作为附加文件附加

我试图复制这个过程

将邮件项目作为附件转发时，请使用 Outlook邮件格式文件（.msg）是原始邮件到新邮件的副本

vba中的示例是

Option Explicit
Sub Example()
    '//  Declare variables
    Dim Msg As Outlook.MailItem
    Dim Item As Outlook.MailItem
    
    ' Select Item
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox ("No Item selected")
        Exit Sub
    End If

    For Each Item In Application.ActiveExplorer.Selection
        Set Msg = Application.CreateItem(olMailItem)

        With Msg
            .Attachments.Add Item, olEmbeddeditem ' Attch Selected email
            .Display
        End With
    Next
    
    '// Clean up
    Set Item = Nothing
    Set Msg = Nothing
End Sub

---

选择要作为.msg复制到新电子邮件的电子邮件，然后运行代码

这对我来说似乎是个x，y问题。。。我完全明白为什么会这样。我只为那些只想将电子邮件复制粘贴到自己身体中的人提供了我的第一个“尝试”解决方案。我知道我将不得不完成重做我的代码，但我想知道是否有人可以告诉我正确的方向。谢谢！这正是我要找的@Om3r是否可以使用您提供的方法将多封搜索到的电子邮件作为附件附加？@Joshua，只需将这一行

Set Msg=Application.CreateItem（olMailItem）

移到Application.ActiveExplorer.Selection中每个项目的

外部
[它创建邮件项目，然后在附加到所选项目时循环浏览所选项目。：-]
Option Explicit
Sub Example()
    '//  Declare variables
    Dim Msg As Outlook.MailItem
    Dim Item As Outlook.MailItem
    
    ' Select Item
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox ("No Item selected")
        Exit Sub
    End If

    For Each Item In Application.ActiveExplorer.Selection
        Set Msg = Application.CreateItem(olMailItem)

        With Msg
            .Attachments.Add Item, olEmbeddeditem ' Attch Selected email
            .Display
        End With
    Next
    
    '// Clean up
    Set Item = Nothing
    Set Msg = Nothing
End Sub