Operating system:: Windows 10
Outlook version: Outlook 2016
Email type or host: Exchage
Outlook version: Outlook 2016
Email type or host: Exchage
The code I was able to geto from Diana's Slipstick Forum Print a list of your Outlook folders and slightly amended to be able to get datetime properpies of the Outlook folder. The output generated in the MS Outlook nested folder is fine, but it does not work with PST folders, the output generates error 'Run-time error '-2147221223 (8004010f0)': "The property http://schemas.microsoft.com/mapi/proptag/0x30070040" is unknown or cannot be found.
Here is the code
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") & "\Downloads\OutlookFolders\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
Dim propertyAccessor As Outlook.propertyAccessor
' 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
Set propertyAccessor = olTempFolder.propertyAccessor
'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 & " " & _
propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30070040")
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
Here is the code
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") & "\Downloads\OutlookFolders\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
Dim propertyAccessor As Outlook.propertyAccessor
' 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
Set propertyAccessor = olTempFolder.propertyAccessor
'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 & " " & _
propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30070040")
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
