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

问题描述

我需要一个可以用于Outlook的宏：

将打开的电子邮件另存为email.msg（包括附件）
关闭当前电子邮件窗口
创建一个新电子邮件，该电子邮件将从email.msg中读取（从步骤1开始）。

我在Google上做了一些研究，但对我没有任何帮助。这是我到目前为止所做的（第一步。..但是没有用）

    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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

new-operator outlook save