Move selected email to a different folder

[RajOberoi]

Hi Guys


I have written following code and it works fine if the 'Completed' folder is within My Inbox (Personnel folder) but in my outlook there are some other group folders as well so if I create 'Completed' folder within the group folder then the below code doesn't work. So I am looking for VBA code that will check the parent folder and if its 'My inbox' then move the email from there to 'Completed' folder within that.


And if the parent folder is different then move selected email to 'Completed' folder within that.




Sub ProcessSelection()
Dim olMailItem As Object
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
On Error Resume Next
For Each olMailItem In Application.ActiveExplorer.Selection
SaveAttachments olMailItem
DoEvents
Next olMailItem
Err_Handler:
Set olMailItem = Nothing
lbl_Exit:
Exit Sub
End Sub



Private Sub SaveAttachments(olItem As Object)
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Completed")
olItem.Move myDestFolder
Set olItem = myItems.FindNext
olItem.Move myDestFolder
Set olItem = myItems.FindNext

[skatonni]

Option Explicit

Sub ProcessSelection()

Dim olItem As Object

If ActiveExplorer.Selection.count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If

For Each olItem In ActiveExplorer.Selection
MoveObject olItem
DoEvents
Next olItem

End Sub

Private Sub MoveObject(olItem As Object)

' Move olItem to a subfolder one level under the applicable Inbox

Dim myParentFolder As Folder
Dim myDestFolder As Folder

Set myParentFolder = olItem.Parent

findInbox:

If myParentFolder = "Inbox" Then
Set myDestFolder = myParentFolder.Folders("Completed")
olItem.move myDestFolder

Else
' Do not run on an item in a folder at the same level as an Inbox.
' The parent will never be "Inbox".
' There will be an error here.
Set myParentFolder = myParentFolder.Parent

GoTo findInbox

End If

End Sub

[RajOberoi]

Thanks Skatonni, It works like a charm. :)