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