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