VBA Script to Get List of Outlook Stores

Option Explicit

' VBA Script to get list of Outlook Stores
' 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
Public Sub GetListOfStores()
    On Error GoTo On_Error
    
    Dim Session As Outlook.NameSpace
    Dim Store As Outlook.Store
    Dim Stores As Outlook.Stores
    Dim Report As String
    
    Set Session = Application.Session
    
    Set Stores = Session.Stores
    For Each Store In Stores
        Report = Report & Store.DisplayName & vbCrLf
        Report = Report & "Location : " & Store.FilePath & vbCrLf
        Report = Report & "Is Cached Exchange : " & Store.IsCachedExchange & vbCrLf
        Report = Report & "Is Data File Store : " & Store.IsDataFileStore & vbCrLf
        Report = Report & "Is Instant Search Enabled : " & Store.IsInstantSearchEnabled & vbCrLf
        Report = Report & "Is Open : " & Store.IsOpen & vbCrLf
        Report = Report & "Class : " & Store.Class & vbCrLf
        Report = Report & "Exchange Store Type : " & Store.ExchangeStoreType & vbCrLf
        Report = Report & "Store ID : " & Store.StoreID & vbCrLf & vbCrLf
    Next Store
    
    Dim retValue As Boolean
    retValue = CreateReportAsEmail("List of Stores", Report)
    
Exiting:
        Set Session = Nothing
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

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

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.