Move Inbox Subfolders

Posted on 2011-05-12
Last Modified: 2012-08-13
I have roughly 1000 mailbox accounts.  Corporate policy has been changed so that there are  to be no subfolders within the "Inbox"

I need to move each users subfolders to a top level mailbox folder called "Archived Emails" I'd rather not move 10,000+ folders one at a time by hand.

Any scripts out there?
Question by:colsontime
    LVL 7

    Expert Comment

    Well you can try to check with the options under teh shell command
    LVL 2

    Author Comment

    Looked, dont see an option  to mass move folders from within an account to the same account but different folder.  
    LVL 76

    Expert Comment

    by:David Lee
    Hi, colsontime.

    I can provide a script that will do this, but it'll have to be run at each computer.  That means either adding the script to a logon script so this can occur automatically, or making a trip to each computer to run the script.  If you're okay with that, then I'll upload the script and instructions.
    LVL 2

    Author Comment


    That sounds good. Please upload.
    LVL 76

    Accepted Solution

    Here's the code.  Follow these instructions to use it.

    1.  Open Notepad
    2.  Copy the code and paste it into Notepad
    3.  Save the file.  You can use any name you choose, the extension must be .vbs
    4.  Double-click the saved file to run the script.

    The script checks to see if the folder Archived Emails exists and creates it if it doesn't.  I then moves all subfolders under the Inbox folder to Archived Emails.
    Const olFolderInbox = 6
    Const FLDNAME = "Archived Emails"
    Dim olkApp, olkSes, olkFld, intCnt
    On Error Resume Next
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNamespace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    Set olkFld = olkSes.GetDefaultFolder(olFolderInbox).Parent.Folders(FLDNAME)
    If TypeName(olkFld) = "Nothing" Or TypeName(olkFld) = "Empty" Then
    	Set olkFld = olkSes.GetDefaultFolder(olFolderInbox).Parent.Folders.Add(FLDNAME)
    End If
    For intCnt = olkSes.GetDefaultFolder(olFolderInbox).Folders.Count To 1 Step -1
    	olkSes.GetDefaultFolder(olFolderInbox).Folders.Item(intCnt).MoveTo olkFld
    Set olkFld = Nothing
    Set olkSes = Nothing
    Set olkApp = Nothing

    Open in new window

    LVL 2

    Author Closing Comment

    Worked perfectly !!!
    LVL 76

    Expert Comment

    by:David Lee

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Join & Write a Comment

    Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
    Exchange server is not supported in any cloud-hosted platform (other than Azure with Azure Premium Storage).
    In this video we show how to create a Shared Mailbox in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Recipients >> Sha…
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

    754 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now