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
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