Как получить список папок в Outlook?

Иногда древовидная структура всех почтовых папок — включая созданные вами личные папки — в области навигации значительно упрощает работу в Outlook. Чтобы мгновенно получить полный список папок в виде удобной древовидной структуры, воспользуйтесь простым кодом VBA. В этом руководстве вы узнаете, как легко сгенерировать такой список с помощью VBA.

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

---

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

Чтобы с помощью кода VBA получить список папок в Outlook, выполните следующие действия.

1. Нажмите сочетание клавиш «Alt» + «F11», чтобы открыть окно Microsoft Visual Basic for Applications.

2. Затем дважды щелкните по элементам «Project1» > «Microsoft Outlook Objects» > «ThisOutlookSession», чтобы открыть окно «Project1 – ThisOutlookSession». См. снимок экрана:

3. Затем скопируйте приведённый ниже код VBA и вставьте его в окно «Project1 – ThisOutlookSession».

VBA: получение списка папок в Outlook

Option Explicit
Sub GetFoldersList()
    On Error GoTo On_Error
    
    Dim Report As String
    Dim Folder As Outlook.Folder
       
    For Each Folder In Application.Session.Folders
        Report = Report & "---------------------------------------------------------------------------" & vbCrLf
        Call RecurseFolders(Folder, "", Report)
    Next
    Call CreateReportEmail("Outlook Folders List", Report)
    
Exiting:
    Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
End Sub
Sub RecurseFolders(CurrentFolder As Outlook.Folder, TabChars, ByRef Report As String)
    Dim SubFolder As Outlook.Folder
    Dim FolderName, StoreName As String
    
    FolderName = CurrentFolder.Name
    StoreName = CurrentFolder.Store.DisplayName
    
    Report = Report & TabChars & FolderName & " (Store: " & StoreName & ")" & vbCrLf
    
    For Each SubFolder In CurrentFolder.Folders
        Call RecurseFolders(SubFolder, TabChars & vbTab, Report)
    Next SubFolder
End Sub
Sub CreateReportEmail(Title As String, Report As String)
    Dim aMail As MailItem
    
    Set aMail = Application.CreateItem(olMailItem)
        
    aMail.Subject = Title
    aMail.Body = Report
    
    aMail.Display
End Sub

4. Нажмите клавишу F5 на клавиатуре, чтобы запустить выполнение кода VBA.

5. Теперь откроется диалоговое окно «Макрос» — нажмите кнопку «Выполнить».

6. Дождитесь завершения выполнения макроса — сразу после этого список всех ваших почтовых папок появится в новом окне сообщения и его можно будет легко распечатать. См. снимок экрана:

Примечание: Этот код VBA подходит для Outlook 2007, 2010 и 2013.