The code below saves the emails when highlited to the destination desired. I would like it to move the email so clear the que instead of making a copy and saving as. I think this line "oMail.SaveAs sPath & sName, olMSG" needs altering

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



For Each objItem In ActiveExplorer.Selection
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
sName = sName & ".msg"

sPath = "J:\hamad\Mails\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub