Vba 保存当前电子邮件并将其重新创建为新邮件

我需要Outlook的宏，该宏将执行以下操作：

将打开的电子邮件另存为email.msg（包括附件）

关闭当前电子邮件窗口

创建一封新的电子邮件，从email.msg（步骤1）读取

---

我在谷歌上做了一些研究，但没有什么对我有用。 这就是我到目前为止所做的（1.步骤..但不起作用）

选项显式
子SaveCurrentItemAsMsg（）
Dim oMail作为邮件项
作为对象的Dim objItem
像细绳一样暗淡
Dim dtDate作为日期
像绳子一样模糊
Dim enviro As字符串
将myItem设置为MailItem
enviro=CStr（环境（“用户档案”））
设置objItem=ActiveInspector.currentItem
如果objItem.MessageClass=“IPM.Note”，则
设置oMail=objItem
sName=oMail.Subject
ReplaceCharsForFileName sName，“电子邮件”
dtDate=oMail.ReceivedTime
sName=格式（dtDate，“yyyymmdd”，vbUseSystemDayOfWeek_
vbUseSystem）和格式（dtDate，“-hhnss”_
vbUseSystemDayOfWeek，vbUseSystem）和“-”以及sName和“.msg”
sPath=enviro&“\Documents\”
调试。打印sPath和sName
oMail.SaveAs sPath&sName，olMsg
奥梅尔，关闭奥迪卡德
设置oMail=Nothing
Set myItem=Session.OpenSharedItem（sPath和sName）
myItem.Display
如果结束
端接头
子SaveSelectedMessagesMassg（）
Dim oMail作为邮件项
作为对象的Dim objItem
像细绳一样暗淡
Dim dtDate作为日期
像绳子一样模糊
Dim enviro As字符串
将myItem设置为MailItem
enviro=CStr（环境（“用户档案”））
对于ActiveExplorer.Selection中的每个对象项
如果objItem.MessageClass=“IPM.Note”，则
设置oMail=objItem
sName=oMail.Subject
ReplaceCharsForFileName sName，“电子邮件”
dtDate=oMail.ReceivedTime
sName=格式（dtDate，“yyyymmdd”，vbUseSystemDayOfWeek_
vbUseSystem）和格式（dtDate，“-hhnss”_
vbUseSystemDayOfWeek，vbUseSystem）和“-”以及sName和“.msg”
sPath=enviro&“\Documents\”
调试。打印sPath和sName
oMail.SaveAs sPath&sName，olMsg
Set myItem=Session.OpenSharedItem（sPath和sName）
myItem.Display
如果结束
下一个
端接头

    Option Explicit
    Public Sub SaveMessageAsMsg()
      Dim oMail As Outlook.MailItem
      Dim objItem As Object
      Dim sPath As String
      Dim dtDate As Date
      Dim sName As String
      Dim enviro As String
     
        enviro = CStr(Environ("USERPROFILE"))
       For Each objItem In ActiveExplorer.Selection
       If objItem.MessageClass = "IPM.Note" Then
        Set oMail = objItem
       
      sName = oMail.Subject
      ReplaceCharsForFileName sName, "email"
     
      dtDate = oMail.ReceivedTime
      sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
        vbUseSystem) & Format(dtDate, "-hhnnss", _
        vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
         
        sPath = enviro & "\Documents\"
      Debug.Print sPath & sName
      oMail.SaveAs sPath & sName, olMsg


'this closes window:

Dim myinspector As Outlook.Inspector
 
Dim myItem As Outlook.MailItem
  
Set myinspector = Application.ActiveInspector
Set myItem = myinspector.CurrentItem
 myItem.Close olSave
      
      End If
      Next
      
    End Sub