Print a List of Outlook Mail Folders

>>
I keep getting an error saying VBA compile error - Invalid Outside Procedure
<<
Did you copy the entire macro or miss a line or two at the end? That will cause the error. Did it highlight any of the lines?

Did you paste it in to ThisOutlookSession or into a new module? It should work in either, but pasting it in a module is recommended, especially if you have other macros.

jamesstjohn 

Sorry that you are having trouble.  I ran the script, and it works.

1) First, try pasting the code again. It sounds like maybe a line of code is missing. It is located at the bottom of this message. If it fails again, see the next bullet.

2) Also, can you check your macro security settings? Although the article recommended changing this setting, I ran the macro without making any changes. 

• File | Options | Trust Center
  Click on Trust Center Settings
  

  Click on Macro Settings
  

  

   

  Please change it to Notification for all macros.  

My recommendation is once your run the macro successfully, repeat the steps above and select original macro security settings.

Here is the code again.

Public strFolders As String
 
Public Sub GetFolderNames()
    Dim olApp As Outlook.Application
    Dim olSession As Outlook.NameSpace
    Dim olStartFolder As Outlook.MAPIFolder
    Dim lCountOfFound As Long
 
    lCountOfFound = 0
      
    Set olApp = New Outlook.Application
    Set olSession = olApp.GetNamespace("MAPI")
      
     ' Allow the user to pick the folder in which to start the search.
    Set olStartFolder = olSession.PickFolder
      
     ' Check to make sure user didn't cancel PickFolder dialog.
    If Not (olStartFolder Is Nothing) Then
         ' Start the search process.
        ProcessFolder olStartFolder
    End If
     
' Create a new mail message with the folder list inserted
Set ListFolders = Application.CreateItem(olMailItem)
  ListFolders.Body = strFolders
  ListFolders.Display

' To create a text file you can open in Excel, use this
strPath = Environ("USERPROFILE") & "\Documents\OutlookFolders.csv"
  Debug.Print strPath
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fileout = fso.CreateTextFile(strPath, True, False)
    Fileout.WriteLine strFolders
      
' clear the string so you can run it on another folder
  strFolders = ""
End Sub
  
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
         
    Dim i As Long
    Dim olNewFolder As Outlook.MAPIFolder
    Dim olTempFolder As Outlook.MAPIFolder
    Dim olTempFolderPath As String
     ' Loop through the items in the current folder.
    For i = CurrentFolder.Folders.Count To 1 Step -1
          
        Set olTempFolder = CurrentFolder.Folders(i)
          
        olTempFolderPath = olTempFolder.FolderPath

     ' Get the count of items in the folder
         olCount = olTempFolder.Items.Count

     'prints the folder path and name in the VB Editor's Immediate window
         Debug.Print olTempFolderPath & " " & olCount
           
        ' prints the folder name only
         ' Debug.Print olTempFolder
          
         ' create a string with the folder names.
         ' use olTempFolder if you want foldernames only
         strFolders = strFolders & vbCrLf & olTempFolderPath & vbTab & olCount
         
        lCountOfFound = lCountOfFound + 1
          
    Next
     ' Loop through and search each subfolder of the current folder.
    For Each olNewFolder In CurrentFolder.Folders
          
         'Don't need to process the Deleted Items folder
        If olNewFolder.Name <> "Deleted Items" Then
            ProcessFolder olNewFolder
        End If
          
    Next
      
End Sub

/Teresa