Outlook VBA Script that gets info on currently selected Folder using the Outlook Object Model

' Outlook VBA Script that gets info on the Currently Selected Folder using the Outlook Object Model
' This script will run on Outlook 2007 and later, but will need modifications for Outlook 2003
' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
' Run Outlook, Press Alt+F11 to open VBA
' Programming by Greg Thatcher, http://www.GregThatcher.com
Option Explicit

Public Sub GetFolderInfoUsingOutlookObjectModel()
    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim folder As Outlook.folder
    Dim report As String
    
    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    
    
    'for all items do...
    For Each currentItem In Selection
        Set folder = currentItem.Parent
        
        report = report & AddToReportIfNotBlank("Name: ", folder.Name)
        report = report & AddToReportIfNotBlank("AddressBookName: ", folder.AddressBookName)
        
        report = report & AddToReportIfNotBlank("CustomViewsOnly: ", folder.CustomViewsOnly)
        report = report & AddToReportIfNotBlank("DefaultItemType: ", folder.DefaultItemType)
        report = report & AddToReportIfNotBlank("DefaultMessageClass: ", folder.DefaultMessageClass)
        report = report & AddToReportIfNotBlank("Description: ", folder.Description)
        report = report & AddToReportIfNotBlank("EntryID: ", folder.EntryID)
        report = report & AddToReportIfNotBlank("FolderPath: ", folder.FolderPath)
        ' report = report & AddToReportIfNotBlank("Name: ", folder.Folders)
        'report = report & AddToReportIfNotBlank("InAppFolderSyncObject: ", folder.InAppFolderSyncObject)
        
        report = report & AddToReportIfNotBlank("IsSharePointFolder: ", folder.IsSharePointFolder)
        ' report = report & AddToReportIfNotBlank("InAppFolderSyncObject: ", folder.Items)
        report = report & AddToReportIfNotBlank("ShowAsOutlookAB: ", folder.ShowAsOutlookAB)
        report = report & AddToReportIfNotBlank("ShowItemCount: ", folder.ShowItemCount)
        report = report & AddToReportIfNotBlank("StoreID: ", folder.StoreID)
        report = report & AddToReportIfNotBlank("UnReadItemCount: ", folder.UnReadItemCount)
        ' report = report & AddToReportIfNotBlank("UserDefinedProperties: ", folder.UserDefinedProperties)
        ' report = report & AddToReportIfNotBlank("Views: ", folder.Views)
        report = report & AddToReportIfNotBlank("WebViewOn: ", folder.WebViewOn)
        report = report & AddToReportIfNotBlank("WebViewURL: ", folder.WebViewURL)
        
        If (folder.CurrentView <> "") Then
            report = report & "View:" & vbCrLf
            report = report & AddToReportIfNotBlank(vbTab & "View Name: ", folder.CurrentView.Name)
            report = report & AddToReportIfNotBlank(vbTab & "Filter: ", folder.CurrentView.Filter)
            report = report & AddToReportIfNotBlank(vbTab & "Language: ", folder.CurrentView.Language)
            report = report & AddToReportIfNotBlank(vbTab & "LockUserChanges: ", folder.CurrentView.LockUserChanges)
            report = report & AddToReportIfNotBlank(vbTab & "SaveOption: ", folder.CurrentView.SaveOption)
            report = report & AddToReportIfNotBlank(vbTab & "Standard: ", folder.CurrentView.Standard)
            report = report & AddToReportIfNotBlank(vbTab & "ViewType: ", folder.CurrentView.ViewType)
            report = report & AddToReportIfNotBlank(vbTab & "XML: ", folder.CurrentView.XML)
        End If
        
        
                    
        report = report & vbCrLf
        report = report & vbCrLf
    Next
    
    
    Call CreateReportAsEmail("Current Folder Report", report)
End Sub

Private Function AddToReportIfNotBlank(FieldName As String, FieldValue As String)
    AddToReportIfNotBlank = ""
    If (FieldValue <> "") Then
        AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
    End If
    
End Function

' VBA SubRoutine which displays a report inside an email
' Programming by Greg Thatcher, http://www.GregThatcher.com
Public Sub 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

    Set Session = Application.Session
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    Set mail = Inbox.Items.Add("IPM.Mail")

    mail.Subject = Title
    mail.Body = report

    mail.Save
    mail.Display
    

Exiting:
        Set Session = Nothing
        Exit Sub

On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Sub