Public Sub List_Info_Stores()
    Dim objApp as Application
    Dim objNS as Namespace
    Dim objFolders as Folders
    Dim objFolder as MAPIFolder
    Dim strMsg as String
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolders = objNS.Folders
    strMsg = ""
    For each objFolder in objFolders
        strMsg = strMsg & objFolder.Name & vbCrLf
    Next
    strMsg = "These stores are available:" & vbCrLf & strMsg
    Msgbox strMsg, , "Available Stores"
End Sub