Как быстро скопировать структуру папок из одного файла Outlook PST в другой через VBA

Если вы хотите скопировать структуру папок из одного PST-файла Outlook в другой, вы можете использовать метод, представленный в этой статье, который научит вас, как использовать VBA, чтобы получить ее за один раз.

Возможно, чтобы лучше управлять своей электронной почтой, вы создали несколько пользовательских папок в своем основном файле Outlook. Таким образом, при создании нового файла Outlook PST вы можете применить ту же структуру папок. Собственно, в моей предыдущей статье — «2 шага, чтобы сохранить текущую папку Hirarchy в новом файле Outlook», вы можете изучить традиционный метод, который использует для этого функцию «Архив». Тем не менее, на самом деле, это все еще немного утомительно. По сравнению с ним, используя коды VBA, получить его будет намного быстрее. Поэтому далее мы расскажем вам о подробных шагах и кодах.

Скопируйте структуру папок из одного файла Outlook PST в другой

1. В самом начале сtarв вашей программе Outlook.
2. Затем в окне Outlook нажмите клавиши «Alt + F11».
3. Далее вы войдете в окно редактора Outlook VBA.
4. Затем скопируйте и вставьте следующие коды VBA в новый модуль.

Public objNewPSTFolder As Outlook.Folder
 
Sub CopyFolderStructure()
    Dim objFolders As Outlook.Folders
    Dim objFolder As Outlook.Folder
 
    'Get the folders of the source Outlook PST file
    Set objFolders = Outlook.Application.Session.Folders("Personal").Folders
 
    'Create the new pst file in your desired local folder and name
    Outlook.Application.Session.AddStore "E:\New PST File.pst"
    Set objNewPSTFolder = Session.Folders.GetLast()
 
    For Each objFolder In objFolders
        CreateFolder objFolder
    Next
 
    MsgBox "Completed!", vbOKOnly + vbInformation, "Copy Folder Structure"
End Sub
 
Sub CreateFolder(objFolder As Outlook.Folder)
    Dim objSubFolder As Outlook.Folder
 
    'Only copy the mail folder
    If (objFolder.DefaultItemType = olMailItem) Then
       'New Outlook PST file auto includes the "Deleted Items" folder, so skip it
       'Skip the useless mail folders - "Conversation Action Settings" and "Quick Step Settings"
       If (objFolder.Name <> "Deleted Items") And (objFolder.Name <> "Conversation Action Settings") And (objFolder.Name <> "Quick Step Settings") Then
 
          'Create the new folder
          objNewPSTFolder.Folders.Add objFolder.Name
          Set objNewPSTFolder = objNewPSTFolder.Folders.Item(objFolder.Name)
 
          For Each objSubFolder In objFolder.Folders
              CreateFolder objSubFolder
          Next
 
          Set objNewPSTFolder = objNewPSTFolder.parent
       End If
    End If

End Sub

5. После этого измените уровень безопасности макроса на низкий.
6. Позже вернитесь в окно редактора VBA и нажмите клавишу «F5», чтобы запустить макрос.
7. Наконец, после того, как макрос завершит работу, вы получите сообщение «Completed!».
8. На этом этапе вы можете перейти к панели навигации почты. Вы увидите новый файл данных Outlook, который находится в той же структуре папок, что и исходный файл PST, как показано на рисунке ниже:

Справиться с удручающими проблемами PST

Поскольку Outlook PST подвержен ошибкам, многие из вас, должно быть, когда-либо сталкивались с различными проблемами в Outlook. Столкнувшись с ними, вы можете сначала попробовать инструмент восстановления почтового ящика Outlook. Если это не удается, вы можете применить более мощный сторонний инструмент, например DataNumen Outlook Repair, Которые могут исправить Outlook Ошибки PST, как ветер.

Об авторе:

Ширли Чжан — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая SQL Server фиксировать и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com