Как узнать список папок Outlook

Допустим, вы хотите собрать список папок в некий список. Казалось бы, узнать имена папок можно следующим образом:

Листинг 1.

Dim AllFolders As Folders  

Set AllFolders = Application.GetNamespace("MAPI").Folders  

MsgBox AllFolders.Count  

For i = 1 To AllFolders.Count  

  MsgBox AllFolder.Item(i).Name  

Next

Однако выясняется, что у вас имеется всего две папки с именами Personal Folders. Здесь полезно вспомнить, что папки OutLook имеют иерархическую структуру, такую же, как знакомая файловая система. Приведенная выше конструкция выдала нам имена стандартных папок самого верхнего уровня.

Чтобы получить информацию о папках второго уровня, нужно написать более сложный код:

Листинг 2.

Dim allFolders As Folders  

Dim i%, j%  

Set allFolders = Application.GetNamespace("MAPI").Folders  

MsgBox "Число папок верхнего уровня = " & allFolders.Count  

' обзор папок верхнего уровня  

For i = 1 To allFolders.Count  

  MsgBox "Имя папки = " & _  

    allFolders.Item(i).Name & vbCrLf & _  

     "  число вложенных папок = " & _  

      allFolders.Item(i).Folders.Count  

  ' обзор папок второго уровня  

  For j = 1 To allFolders.Item(i).Folders.Count  

     MsgBox "Имена вложенной папки = " & _  

       allFolders.Item(i).Folders.Item(j).Name & vbCrLf & _  

        " число вложенных в нее папок = " & _  

        allFolders.Item(i).Folders.Item(j).Folders.Count  

  Next  

Next

Однако понятно, что наращивание числа вложенных циклов для обзора иерархических структур является совершенно бесперспективным занятием. (В нашем примере одна из папок второго уровня — Contacts — имеет также вложенную папку.) Здесь требуется переходить к рекурсивным конструкциям, которые могут выглядеть примерно так:

Листинг 3.

Dim allFolders As Folders  

Dim intLevel%  ' номер уровня  

intLevel = 0  

Set allFolders = Application.GetNamespace("MAPI").Folders  

Call FoldersViewRecurse(allFolders, intLevel, "MAPI")  

   

Sub FoldersViewRecurse(allFolders As Folders, intLevel%, strName$)  

  Dim i%, FolderName$  

  Dim newFolders As Folders  

  ' Вывод информации о папках данного узла иерархической структуры  

  Debug.Print "Уровень = "; intLevel; " Узел = "; _  

    strName$; Tab(45); " Вложенных папок = "; allFolders.Count  

  If allFolders.Count > 0 Then ' есть вложенные папки  

    For i = 1 To allFolders.Count  ' обзор вложенных папок  

      FolderName$ = allFolders.Item(i).Name  

      Set newFolders = allFolders.Item(i).Folders  

      ' рекурсивное обращение к самой себе:  

      Call FoldersViewRecurse(newFolders, intLevel + 1, FolderName$)  

    Next  

  End If  

End Sub