Re: Subject: Outlook - Choose root folder then delete all subfolders n

Tech-Archive recommends: Speed Up your PC by fixing your registry



You might modify the CreateFolderSetInSubFolders procedure. This shoudl
delete every subfolder of the selected root folder.

Dim i&
Dim Folders as Outlook.Folders

' ... select root folder here

Set Folders=objRootFolder.Folders

For i=Folders.Count to 1 step-1
Folders.Remove i
Next

--
Best regards
Michael Bauer - MVP Outlook
Synchronize Outlook Categories:
<http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6>


Am Mon, 7 Jan 2008 15:33:02 -0800 schrieb 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 Sub

'------------------------------------------------------------------------------------------------


Any help would be greatly appreciated.

Best Regards,

Jeff
.

Quantcast