Moving an email from a shared Inbox to a subfolder

Question

I am trying to move some emails that comes into our shared inbox (ABC COMPANY) to a subfolder (A&D) that is created inside a main folder (DAILY INFO). I have only found in the web, a macro that moves the emails from the shared inbox to the main folder, but not into the sub folder. Here is the code i found.

 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

FunThomas FunThomas · Accepted Answer · 2019-11-04T08:32:14

Every folder contains a folders-collection that holds its subfolders.

Assuming that your folders exists, do something like

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

of course you could do this with a single statement, but this makes it harder to debug if something fails

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

Moving an email from a shared Inbox to a subfolder

1 Answers