Move selected email to a different folder

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.

Code:

---

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

---

Code:

---

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

---

Code:

---

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

---

Thanks Skatonni, It works like a charm. :)