MyTetra Share
Делитесь знаниями!
outlook-vba 3.1 Функция GetFldrNames (), которая необходима для нескольких демонстрационных макросов
09.04.2020
19:32
Текстовые метки: outlook-vba
Раздел: !Закладки - VBA - Outlook - outlook-vba

outlook-vbaВведение Часть 3: Магазины и все их папки


Вступление#

Завершает введение в магазины и папки, запущенные во второй части этого руководства

Ожидаемые предварительные знания : вы изучили часть 2 этого руководства или уже знакомы с его содержанием.

Введение Часть 3: Магазины и все их папки Связанные примеры#


outlook-vba 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


Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования