Расширение подпапки Outlook

У меня есть код для расширения папок в Outlook. Он работает для папок первого уровня, но не расширяет подпапки (в данном случае папку xx Progressions).

Код не глючит: подпапка просто не расширяется.

Private Sub ExpandFolders()

Dim objCurrentFolder As Outlook.Folder
Dim objStore As Outlook.Store
Dim objFileFolders As Outlook.Folders
Dim objFolder As Outlook.Folder
Dim objView As Outlook.View

'Expand xx Notifications
Set objStore = Outlook.Application.Session.Stores("xxNotification")
Set objFileFolders = objStore.GetRootFolder.Folders
Set Application.ActiveExplorer.CurrentFolder = objFileFolders("Inbox") 'Works fine

'Expand xx Delivery Support
Set objStore = Outlook.Application.Session.Stores("xxDeliverySupport")
Set objFileFolders = objStore.GetRootFolder.Folders
Set Application.ActiveExplorer.CurrentFolder = objFileFolders("Inbox")
Set Application.ActiveExplorer.CurrentFolder = objFileFolders("Inbox").Folders("xx Progressions") 'Does not expand

'User inbox
Set objStore = Outlook.Application.Session.Stores("[email protected]")
Set objFileFolders = objStore.GetRootFolder.Folders
Set Application.ActiveExplorer.CurrentFolder = objFileFolders("Inbox") 'Works fine

End Sub

outlook vba expand
person Phil T    schedule 26.02.2020    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Вы обманом расширяете папку, выбирая папку под ней.

Пройдитесь по коду, чтобы увидеть, что расширение «отложено» на одну папку.

Option Explicit

Private Sub ExpandFolders()

Dim objStore As store
Dim objFileFolders As folders
Dim objCurrentFolder As Folder

Set objStore = Session.Stores("xxDeliverySupport")

Set objFileFolders = objStore.GetRootFolder.folders

' expand "xxDeliverySupport" by selecting Inbox
Set ActiveExplorer.CurrentFolder = objFileFolders("Inbox")

Set objCurrentFolder = ActiveExplorer.CurrentFolder

' expand "Inbox" by selecting "xx Progressions"
Set ActiveExplorer.CurrentFolder = objCurrentFolder.folders("xx Progressions")

Set objCurrentFolder = ActiveExplorer.CurrentFolder

' expand "xx Progressions" by selecting folder one level below
Set ActiveExplorer.CurrentFolder = objCurrentFolder.folders(1)

End Sub
person niton    schedule 26.02.2020
comment
Спасибо, нитон! Это действительно полезно. Я поместил этот код в application_startup, и он отлично работает, за исключением небольшой проблемы: последняя папка в коде — это та, которая выбирается по умолчанию при запуске Outlook (как и следовало ожидать), но если я попытаюсь выбрать другой почтовый ящик, Outlook просто возвращается к этому. Нужно ли что-то отключать или сбрасывать в конце кода? Спасибо еще раз. - person Phil T; 27.02.2020
comment
Я не вижу причин для такого поведения. Поставьте точку останова, возможно, application_startup запускается каким-то другим кодом. - person niton; 27.02.2020