Як пакетно переміщувати електронні листи з усіх підпапок однієї папки в іншу папку в Outlook

Поділитися зараз:

Можливо, у вас є папка, в якій є безліч підпапок. Якщо ви хочете реорганізувати електронні листи в них, наприклад, швидко перенести всі електронні листи з цих підпапок до певної папки, ви можете скористатись способом, наведеним у цій статті.

Іноді вам може знадобитися пакетне переміщення електронних листів із усіх підпапок однієї папки в іншу з якихось причин, наприклад, якщо ви хочете перекласифікувати електронні листи, тому ці підпапки більше не будуть корисними. У цьому випадку обробка цих підпапок одна за одною є досить складною. Тому тут ми познайомимо вас з іншим способом.

Пакетне переміщення електронних листів із усіх підпапок однієї папки в іншу папку в Outlook

Пакетне переміщення електронних листів із усіх підпапок однієї папки в іншу папку

  1. На самому початку запустіть програму Outlook.
  2. Потім на головному екрані Outlook торкніться кнопок «Alt + F11», що призведе до редактора VBA.
  3. Далі, у новому вікні “Microsoft Visual Basic for Applications” потрібно відкрити модуль, який не використовується.
  4. Згодом скопіюйте та вставте наступний код VBA в цей модуль.
Dim objTargetFolder As Outlook.folder

Sub BatchMoveEmailsFromSubfoldersToAnotherFolder()
    Dim objSourceFolder As Outlook.folder
    Dim objFolder As Outlook.folder
  
    'Get the source folder whose subfolders to be processed
    Set objSourceFolder = Application.Session.PickFolder
 
    If Not (objSourceFolder Is Nothing) And objSourceFolder.DefaultItemType = olMailItem Then
       If objSourceFolder.folders.count > 0 Then
          'Select a target folder
          Set objTargetFolder = Application.Session.PickFolder
          If Not (objTargetFolder Is Nothing) Then
             For Each objFolder In objSourceFolder.folders
                 Call ProcessFolders(objFolder)
             Next
             MsgBox "Move Completed!", vbExclamation
          End If
       Else
          MsgBox "No subfolders!", vbExclamation
       End If
    End If
End Sub

Sub ProcessFolders(ByVal objFolder As Outlook.folder)
    Dim i As Long
    Dim objSubfolder As Outlook.folder
 
    For i = objFolder.Items.count To 1 Step -1
        'Move emails to the target folder
        If objFolder.Items(i).Class = olMail Then
           objFolder.Items(i).Move objTargetFolder
        End If
    Next
 
    'Process subfolders recursively
    If objFolder.folders.count > 0 Then
       For Each objSubfolder In objFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

Код VBA - пакетне переміщення електронних листів із усіх підпапок однієї папки в іншу папку

  1. Після цього ви можете запустити цей макрос.
  • По-перше, у цьому вікні макросу натисніть клавішу “F5”.
  • Потім вам потрібно буде вибрати вихідну папку, підпапки якої потрібно обробити.Виберіть папку джерела
  • Після цього вам потрібно вказати цільову папку, куди ви хочете перемістити електронні листи.
  • Згодом цей макрос почне працювати. Після його завершення ви отримаєте повідомлення «Завершено».
  • Зрештою, ви можете отримати доступ до цільової папки. Ви побачите, що всі електронні листи з підпапок у вихідній папці були там.

Відновлення компрометованих даних Outlook

Не дивлячись на численні функції, як і інші поштові клієнти, Outlook також не може уникнути корупції. Зі збереженням все більшої кількості даних Outlook буде дедалі більше схильний до помилок та пошкоджень. Отже, вам потрібно тримати під рукою потужний інструмент для ремонту, наприклад DataNumen Outlook Repair. Це спеціально розроблено для виправити Outlook питань. Таким чином, він може легко і легко сканувати та відновлювати пошкоджений файл Outlook.

Вступ автора:

Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі відновлення mdf та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте www.datKanumen.com

Поділитися зараз:

Коментарі закриті.