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
Next
Dim retValue As Boolean
retValue = CreateReportAsEmail("List of Folders", Report)
Exiting:
Set Session = Nothing
Exit Sub
On_Error:
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.Recipients.ResolveAll
mail.Subject = Title
mail.Body = Report
mail.Save
mail.Display
Exiting:
Set Session = Nothing
Exit Function
On_Error:
CreateReportAsEmail = False
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting
End Function
|