Lista folderów Outlooka

by vbatools on Feb.21, 2012, under Outlook, Porady

Poniżej znajduje się kod, który zwraca w oknie immediate [Ctrl+G] nazwy folderów. Ciekawą w jej konstrukcji jest zapętlenie wywołania funkcji, która sama wywołuje “siebie”, aby pobrać dane folderu podrzędnego.

W czym kod ten może być przydatny? Otóż do tworzenia archiwizacji czy eksportu danych do baz danych z zachowaniem pełnej struktury zapisu.

Sub OutlookFolders()
 Dim olNamespace As Outlook.NameSpace
 Dim olFolder As Outlook.Folders
 Dim objFolder As Outlook.MAPIFolder

 Set olNamespace = Application.GetNamespace("MAPI")
 Set olFolder = olNamespace.Folders

 For Each objFolder In olFolder
   Call LoopFolders(objFolder.Folders)
 Next

 Set olNamespace = Nothing
 Set olFolder = Nothing
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders)
 Dim Fold As Outlook.MAPIFolder

 For Each Fold In Folders
   Debug.Print Fold.FolderPath
   DoEvents
   If Fold.Folders.Count Then _
     LoopFolders Fold.Folders 
 Next
End Sub

Rys 1. Lista folderów.

Aby pobrać jedynie nazwę bez ścieżki należy zamiast FolderPath pobrać parametr Name lub w obecnym wymiarze pobrać funkcją InStrRev miejsce znaku “”