A number of the demonstration macros within this part requires a function which I will explain later. For the moment, please just copy
GetFldrNames() to a suitable module. I use this function frequently and keep it, and other like it that I use in many different macros, in a module named “ModGlobalOutlook”. You might like to do the same. Alternatively, you might prefer to keep the macro with all the other macros within this tutorial series; you can move it later if you change your mind.
Public Function GetFldrNames(ByRef Fldr As Folder) As String() ' * Fldr is a folder. It could be a store, the child of a store, ' the grandchild of a store or more deeply nested. ' * Return the name of that folder as a string array in the sequence: ' (0)=StoreName (1)=Level1FolderName (2)=Level2FolderName ... ' 12Oct16 Coded ' 20Oct16 Renamed from GetFldrNameStr and amended to return a string array ' rather than a string Dim FldrCrnt As Folder Dim FldrNameCrnt As String Dim FldrNames() As String Dim FldrNamesRev() As String Dim FldrPrnt As Folder Dim InxFN As Long Dim InxFnR As Long Set FldrCrnt = Fldr FldrNameCrnt = FldrCrnt.Name ReDim FldrNamesRev(0 To 0) FldrNamesRev(0) = Fldr.Name ' Loop getting parents until FldrCrnt has no parent. ' Add names of Fldr and all its parents to FldrName as they are found Do While True Set FldrPrnt = Nothing On Error Resume Next Set FldrPrnt = Nothing ' Ensure value is Nothing if following statement fails Set FldrPrnt = FldrCrnt.Parent On Error GoTo 0 If FldrPrnt Is Nothing Then ' FldrCrnt has no parent Exit Do End If ReDim Preserve FldrNamesRev(0 To UBound(FldrNamesRev) + 1) FldrNamesRev(UBound(FldrNamesRev)) = FldrPrnt.Name Set FldrCrnt = FldrPrnt Loop ' Copy names to FldrNames in reverse sequence so they end up in the correct sequence ReDim FldrNames(0 To UBound(FldrNamesRev)) InxFN = 0 For InxFnR = UBound(FldrNamesRev) To 0 Step -1 FldrNames(InxFN) = FldrNamesRev(InxFnR) InxFN = InxFN + 1 Next GetFldrNames = FldrNames End Function