Расширение подпапки VBA Outlook - PullRequest
Новая
       43

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

0 голосов
/ 26 февраля 2020

У меня есть код, который должен расширить некоторые папки в 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("xx.xx@xx.com")
Set objFileFolders = objStore.GetRootFolder.Folders
Set Application.ActiveExplorer.CurrentFolder = objFileFolders("Inbox") 'Works fine

End Sub

1 Ответ

0 голосов
/ 26 февраля 2020

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

Пройдите по коду, чтобы увидеть, что расширение "задерживается" на одну папку. 

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
...