Note: The other languages of the website are Google-translated. Back to English

Как пакетно удалить все пустые папки в Outlook?

Предположим, что есть десятки пустых папок под почтовой папкой в ​​Outlook, обычно мы можем удалить пустые папки одну за другой, щелкнув меню правой кнопкой мыши. По сравнению с многократным щелчком правой кнопкой мыши в этой статье будет представлен VBA для быстрого удаления всех пустых подпапок одной папки Outlook сразу.

Пакетное удаление всех пустых папок в Outlook с помощью VBA

Вкладка Office - включите редактирование и просмотр с вкладками в Office и сделайте работу намного проще ...
Kutools for Outlook - приносит 100 мощных расширенных функций в Microsoft Outlook
  • Авто CC / BCC по правилам при отправке электронной почты; Автопересылка Множественные письма по правилам; Автоответчик без сервера обмена и дополнительных автоматических функций ...
  • Предупреждение BCC - показывать сообщение при попытке ответить всем, если ваш почтовый адрес находится в списке BCC; Напоминать об отсутствии вложений, и многое другое напоминает функции ...
  • Ответить (всем) со всеми вложениями в почтовой переписке; Отвечайте сразу на несколько писем; Автоматическое добавление приветствия при ответе; Автоматически добавлять дату и время в тему ...
  • Инструменты для вложения: Автоотключение, Сжать все, Переименовать все, Автосохранение всех ... Быстрый отчет, Подсчет выбранных писем, Удаление повторяющихся писем и контактов ...
  • Более 100 дополнительных функций будут решить большинство ваших проблем в Outlook 2021–2010 или Office 365. Полнофункциональная 60-дневная бесплатная пробная версия.

стрелка синий правый пузырьПакетное удаление всех пустых папок в Outlook с помощью VBA

Чтобы удалить все пустые подпапки определенной папки Outlook, сделайте следующее:

1, нажмите другой + F11 клавиши, чтобы открыть окно Microsoft Visual Basic для приложений.

2. Нажмите Вставить > Модули, и вставьте ниже код VBA в новое окно модуля.

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 Ключ или Run кнопку, чтобы запустить этот код VBA.

4. Во всплывающем диалоговом окне «Выбрать папку» выберите конкретную папку, пустые подпапки которой вы будете удалять массово, и нажмите кнопку OK кнопка. Смотрите скриншот:

5. Теперь появляется диалоговое окно Kutools for Outlook и показывает, сколько пустых подпапок было удалено. Щелкните значок OK чтобы закрыть его.

До сих пор все подпапки указанной папки Outlook уже были удалены массово.


стрелка синий правый пузырьСтатьи по теме

Найти папку (полный путь к папке) по имени папки в Outlook


Kutools for Outlook - добавляет в Outlook 100 расширенных функций и делает работу намного проще!

  • Авто CC / BCC по правилам при отправке электронной почты; Автопересылка Несколько писем по индивидуальному заказу; Автоответчик без сервера обмена и дополнительных автоматических функций ...
  • Предупреждение BCC - показать сообщение при попытке ответить всем если ваш почтовый адрес находится в списке BCC; Напоминать об отсутствии вложений, и многое другое напоминает функции ...
  • Ответить (всем) со всеми вложениями в почтовой беседе; Ответить на много писем в секундах; Автоматическое добавление приветствия при ответе; Добавить дату в тему ...
  • Инструменты для вложений: управление всеми вложениями во всех письмах, Авто отсоединение, Сжать все, Переименовать все, сохранить все ... Быстрый отчет, Подсчет выбранных писем...
  • Мощные нежелательные электронные письма по обычаю; Удаление повторяющихся писем и контактов... Позвольте вам делать в Outlook умнее, быстрее и лучше.
выстрел kutools outlook kutools tab 1180x121
выстрел kutools outlook kutools plus tab 1180x121
 
Сортировать комментарии по
Комментарии (10)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Brilliant !!!
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю следующую ошибку при запуске вышеуказанного "Ошибка времени выполнения" -2147352567 (80020009) "Невозможно удалить эту папку. Щелкните правой кнопкой мыши папку, а затем выберите свойства, чтобы проверить свои разрешения для папки. См. владельца папки или ваш администратор, чтобы изменить ваши разрешения"

Похоже, скрипт перемещает 1 элемент в удаленную папку, а затем выдает ошибку.
Этот комментарий был сведен к минимуму модератором на сайте
Согласен - получаю ту же ошибку.
Этот комментарий был сведен к минимуму модератором на сайте
Скрипт пытается удалить уже удаленную папку.
Я добавил строку после xFlag = False с таким содержимым:
при ошибке возобновить следующий
Этот комментарий был сведен к минимуму модератором на сайте
Действительно, добавьте:

On Error Resume Next

ПОСЛЕ:

Dim x Fldr As Folder 'Объявить объекты подпапок
xFlag = Ложь

Он должен выглядеть так:

Dim x Fldr As Folder 'Объявить объекты подпапок
xFlag = Ложь
On Error Resume Next
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю ту же ошибку, что и Брайан.... и теперь?
Этот комментарий был сведен к минимуму модератором на сайте
Скрипт пытается удалить уже удаленную папку.
Я добавил строку после xFlag = False с таким содержимым:
при ошибке возобновить следующий
Этот комментарий был сведен к минимуму модератором на сайте
Супер просто и невероятно полезно. Спасибо!!
Этот комментарий был сведен к минимуму модератором на сайте
Было удалено 74 пустых папки, но, к сожалению, и 109 папок, которых не было. Другие пустые папки остались нетронутыми.
Этот комментарий был сведен к минимуму модератором на сайте
Это отлично сработало для меня. Спасибо. Некоторые папки нельзя удалить, так как они являются родными для Outlook, но вложенные папки прекрасно работают.
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL