Перемещение электронной почты из общей папки «Входящие» в подпапку

Question

Я пытаюсь переместить некоторые электронные письма, которые поступают в нашу общую папку «Входящие» (ABC COMPANY), в подпапку (A & D), которая создается внутри главной папки (ЕЖЕДНЕВНАЯ ИНФОРМАЦИЯ). Я нашел только в Интернете макрос, который перемещает электронные письма из общей папки «Входящие» в основную папку, но не в подпапку. Вот код, который я нашел.

 Dim NS As NameSpace

 Dim sharedInbox As folder

 Dim sharedDestinationFolder As folder

 Dim sharedItems As Selection

 Dim i As Long

    Set NS = Application.GetNamespace("MAPI")
    Set sharedInbox = NS.Folders("ABC COMPANY").Folders("Inbox")
    Set sharedDestinationFolder = sharedInbox.Folders("DAILY INFO")

    Set sharedItems = ActiveExplorer.Selection

   ' Counting in reverse
    'when changing the number of items in a collection
    For i = sharedItems.Count To 1 Step -1
        sharedItems(i).Move sharedDestinationFolder
    Next i

ExitRoutine:
    Set NS = Nothing
    Set sharedItems = Nothing
    Set sharedInbox = Nothing
    Set sharedDestinationFolder = Nothing


End Sub

Answer 1

Каждая folder содержит folders -коллекцию, которая содержит свои подпапки.

Предполагая, что ваши папки существуют, сделайте что-то вроде

Set sharedDestinationFolder = sharedInbox.Folders("DAILY INFO")
Set sharedDestinationFolder = sharedDestinationFolder.Folders("A&D")

Конечно, вы можете сделать это содно утверждение, но это усложняет отладку в случае сбоя

Set sharedDestinationFolder = sharedInbox.Folders("DAILY INFO").Folders("A&D")