لإزالة كافة المجلدات الفرعية الفارغة لمجلد Outlook معين ، يرجى القيام بما يلي:

1. صحافة قديم + F11 مفاتيح لفتح نافذة ميكروسوفت فيسوال باسيك للتطبيقات.

2. انقر إدراج > وحدة، والصق رمز VBA أدناه في نافذة الوحدة النمطية الجديدة.

فبا: احذف جميع المجلدات الفرعية الفارغة لمجلد Outlook معين بشكل مجمّع

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, "Kutools for Outlook"
Else
MsgBox "No empty folders found", vbExclamation + vbOKOnly, "Kutools for Outlook"
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

3. صحافة F5 مفتاح أو يجري زر لتشغيل رمز فبا هذا.

4. في مربع الحوار تحديد مجلد المنبثق ، يرجى تحديد المجلد المحدد الذي ستحذف مجلداته الفرعية الفارغة بالجملة ، وانقر فوق OK زر. انظر لقطة الشاشة:

5. يظهر الآن مربع حوار Kutools for Outlook ويظهر لك عدد المجلدات الفرعية الفارغة التي تم حذفها. انقر على OK زر لإغلاقه.

حتى الآن ، تم بالفعل حذف كافة المجلدات الفرعية لمجلد Outlook المحدد بشكل مجمع.