[Last Call] Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 829
  • Last Modified:

Move Inbox Subfolders

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?
  • 3
  • 3
1 Solution
Well you can try to check with the options under teh shell command
colsontimeAuthor Commented:
Looked, dont see an option  to mass move folders from within an account to the same account but different folder.  
David LeeCommented:
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.
 The Evil-ution of Network Security Threats

What are the hacks that forever changed the security industry? To answer that question, we created an exciting new eBook that takes you on a trip through hacking history. It explores the top hacks from the 80s to 2010s, why they mattered, and how the security industry responded.

colsontimeAuthor Commented:

That sounds good. Please upload.
David LeeCommented:
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

colsontimeAuthor Commented:
Worked perfectly !!!
David LeeCommented:

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now