3.1 函数 GetFldrNames() 是几个演示宏所需要的

这部分中的许多演示宏需要一个函数,我将在后面解释。目前,请将 GetFldrNames() 复制到合适的模块中。我经常使用这个函数,并在名为 ModGlobalOutlook 的模块中保留它,以及我在许多不同的宏中使用的其他函数。你可能也喜欢这样做。或者,你可能更喜欢将宏与本教程系列中的所有其他宏保持一致; 如果你改变主意,你可以稍后移动它。

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