Copy the following Code into the module:
Sub ListAllFoldersPlaceInMailItem()
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oFolders As Folders
Dim strFolderList As String
Dim oMailItem As MailItem
Set oNameSpace = Application.GetNamespace("MAPI")
Set oFolders = oNameSpace.Folders
Set oFolder = oFolders.GetFirst
Do While Not oFolder Is Nothing
strFolderList = strFolderList & oFolder.FolderPath & vbCr
strFolderList = strFolderList & ListAllSubFolders(oFolder)
Set oFolder = oFolders.GetNext
Loop
Set oMailItem = Application.CreateItem(olMailItem)
oMailItem.Body = strFolderList
oMailItem.Display
End Sub
Function ListAllSubFolders(oParentFolder As MAPIFolder) As String
Dim oFolders As Outlook.Folders
Dim oFolder As Outlook.MAPIFolder
Dim strFolderList As String
On Error GoTo ExitFunction
Set oFolders = oParentFolder.Folders
Set oFolder = oFolders.GetFirst
Do While Not oFolder Is Nothing
strFolderList = strFolderList & oFolder.FolderPath & vbCr
strFolderList = strFolderList & ListAllSubFolders(oFolder)
Set oFolder = oFolders.GetNext
Loop
 ExitFunction:
ListAllSubFolders = strFolderList
End Function