Consulting

Results 1 to 3 of 3

Thread: Move selected email to a different folder

  1. #1

    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.


    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

  2. #2
    VBAX Mentor skatonni's Avatar
    Joined
    Jun 2006
    Posts
    347
    Location
    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
    To debug, mouse-click anywhere in the code. Press F8 repeatedly to step through the code. http://www.cpearson.com/excel/DebuggingVBA.aspx

    If your problem has been solved in your thread, mark the thread "Solved" by going to the "Thread Tools" dropdown at the top of the thread. You might also consider rating the thread by going to the "Rate Thread" dropdown.

  3. #3
    Thanks Skatonni, It works like a charm.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •