Save current email and recreate it as new mail - vba

Question

I need a macro for Outlook that will do:
Saves the open e-mail as email.msg (including attachments)
Closes the curent e-mail window
Creates a new email, which is read from email.msg (from step 1.)
I did some research on google, but nothing works for me.
This is what i've done so far (the 1. step.. but not working)
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

Answer 1

Option Explicit
Sub SaveCurrentItemAsMsg()
Dim oMail As MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim myItem As MailItem
enviro = CStr(Environ("USERPROFILE"))
Set objItem = ActiveInspector.currentItem
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
oMail.Close olDiscard
Set oMail = Nothing
Set myItem = Session.OpenSharedItem(sPath & sName)
myItem.Display
End If
End Sub
Sub SaveSelectedMessagesAsMsg()
Dim oMail As MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim myItem As MailItem
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
Set myItem = Session.OpenSharedItem(sPath & sName)
myItem.Display
End If
Next
End Sub