|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
Public Sub DeletindEmtpyFolder() Dim xFolders As Folders Dim xCount As Long Dim xFlag As Boolean Set xFolders = Application.GetNamespace("MAPI").PickFolder.Folders Do FolderPurge xFolders, xFlag, xCount Loop Until (Not xFlag) If xCount > 0 Then MsgBox "Deleted " & xCount & "(s) empty folders", vbExclamation + vbOKOnly Else MsgBox "No empty folders found", vbExclamation + vbOKOnly End If End Sub Public Sub FolderPurge(xFolders, xFlag, xCount) Dim I As Long Dim xFldr As Folder 'Declare sub folder objects xFlag = False If xFolders.Count > 0 Then For I = xFolders.Count To 1 Step -1 Set xFldr = xFolders.Item(I) If xFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders If xFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion xFldr.Delete 'Delete the folder xFlag = True xCount = xCount + 1 Else 'Folder contains sub folders so confirm deletion FolderPurge xFldr.Folders, xFlag, xCount End If Else 'Folder contains items or (subfolders that may be empty). FolderPurge xFldr.Folders, xFlag, xCount End If Next End If End Sub |
Author Details
testest testÂ