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

Question

我是新的使用VBA，我已经环顾四周试图找到一个解决方案。我不知道这是否可能，但我要试一试，看看是否有人能想出任何主意。

所以当你进入Outlook，右键点击邮件时，你可以选择复制。当您创建一个新的电子邮件并粘贴电子邮件时，复制的电子邮件将作为。msg作为附加文件附加。

我正在尝试复制这个过程。现在我的进程是

1. 找到邮件

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

2. 显示邮件

   olMail.Display 
   

3. 复制正文并设置文本为strPaste

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

4. 创建新邮箱

   MailItem = OlApp.CreateItem(0)
   

5. 粘贴身体

   .Body = strPaste
   

这是有效的，但它不是那么干净，因为还有其他的东西要进入一个消息，它会更好地将复制的电子邮件附加到电子邮件而不是复制正文。

我也不想将电子邮件保存为。msg，然后附加它，因为其他人将使用宏，这将是相当繁琐的改变路径的电子邮件得到保存为每个人。

任何建议将是伟大的!

Answer 1

所以当你进入Outlook，右键点击邮件时，你可以选择复制。当您创建一个新的电子邮件并粘贴电子邮件时，复制的电子邮件将作为。msg作为附加文件附加。

我正在尝试复制这个过程。

当将MailItem作为附件转发时，使用olEmbeddeditem其中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到新电子邮件的电子邮件，然后运行代码