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
|