VBA Script that gets list of Outlook Folders

Public Sub GetListOfFolders()
    On Error GoTo On_Error
    Dim Session As Outlook.NameSpace
    Dim Report As String
    Dim Folders As Outlook.Folders
    Dim Folder As Outlook.Folder
    Dim reply As Integer
    Set Session = Application.Session
    Set Folders = Session.Folders
    For Each Folder In Folders
        Call RecurseFolders(Folder, vbTab, Report)
        Report = Report & "---------------------------------------------------------------------------" & vbCrLf
    Dim retValue As Boolean
    retValue = CreateReportAsEmail("List of Folders", Report)
        Set Session = Nothing
        Exit Sub
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Sub

Private Sub RecurseFolders(CurrentFolder As Outlook.Folder, Tabs, Report As String)
    Dim Table As Outlook.Table
    Dim Row As Outlook.Row
    Dim rowValues() As Variant
    Dim SubFolders As Outlook.Folders
    Dim SubFolder As Outlook.Folder
    Report = Report & Tabs & "Folder Name: " & CurrentFolder.Name & " (Store: " & CurrentFolder.Store.DisplayName & ")" & vbCrLf
    Set SubFolders = CurrentFolder.Folders
    For Each SubFolder In SubFolders
        Call RecurseFolders(SubFolder, Tabs & vbTab, Report)
    Next SubFolder

End Sub

' VBA Function which displays a report inside an email
Public Function CreateReportAsEmail(Title As String, Report As String)
    On Error GoTo On_Error
    Dim Session As Outlook.NameSpace
    Dim mail As MailItem
    Dim MyAddress As addressEntry
    Dim Inbox As Outlook.Folder
    CreateReportAsEmail = True
    Set Session = Application.Session
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    Set mail = Inbox.Items.Add("IPM.Mail")
    Set MyAddress = Session.CurrentUser.addressEntry
    mail.Recipients.Add (MyAddress.Address)
    mail.Subject = Title
    mail.Body = Report
        Set Session = Nothing
        Exit Function
    CreateReportAsEmail = False
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Function

Problems, Comments, Suggestions? Click here to contact Greg Thatcher

Please read my Disclaimer

Copyright (c) 2013 Thatcher Development Software, LLC. All rights reserved. No claim to original U.S. Gov't works.