Разширяване на подпапка на 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
Благодаря niton! Това е наистина полезно. Поставих този код в application_startup и той работи перфектно, с изключение на малък проблем: последната папка в кода е тази, която е избрана по подразбиране при стартиране на Outlook (както бихте очаквали), но ако се опитам да избера друга входяща кутия, Outlook просто се връща към тази. Има ли нужда от деактивиране или нулиране на нещо в края на кода? Благодаря отново. - person Phil T; 27.02.2020
comment
Не виждам причина за това поведение. Поставете точка на прекъсване, може би application_startup се задейства от някакъв друг код. - person niton; 27.02.2020