Outlook - Choose root folder then delete all subfolders named (X)

R

Road Rebel

A couple of years ago a very kind programmer on this site handed off the
following code to me. This code allows me to (at the beginning of each year)
create a series of subfolders beneath a selected root folder. We are now
faced with many years of data in our public folders and I am looking for an
eays way to clean it up. Is there anyone out there that can assist me in
modifying the following code to delete folders instead of creating them? I
have the following folder structure on my system:

Root Folder

+"Folder A"

++2005

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2006

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2007

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2008

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

+"Folder B"

++2005

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2006

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2007

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

++2008

+++Air
+++Busing
+++Cars
+++Freight
+++Housing

Here is the current code I am using to create folders every January 1st
'------------------------------------------------------------------------------------------------
Sub CreateFolderSetInSubFolders()
On Error Resume Next

Dim objRootFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
'top level folder
Set objRootFolder = objNS.PickFolder

If objRootFolder Is Nothing Then Exit Sub

'create folder sets in subfolders of chosen folder
For Each objFolder In objRootFolder.Folders
CreateFolderSet objFolder
Next

Set objRootFolder = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub

Private Sub CreateFolderSet(objCurrentFolder As Outlook.MAPIFolder)
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder

Set objFolder = objCurrentFolder.Folders("2009")

If objFolder Is Nothing Then
'folder doesn't exist - create
Set objFolder = objCurrentFolder.Folders.Add("2009")
objFolder.Folders.Add "Cars"
objFolder.Folders.Add "Housing"
objFolder.Folders.Add "Air"
objFolder.Folders.Add "Busing"
objFolder.Folders.Add "Freight"
End If

Set objFolder = Nothing
End Su
'------------------------------------------------------------------------------------------------


Any help would be greatly appreciated.

Best Regards,

Jeff
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top