Recursive folder search in shared mailbox

Question

I'm not super familiar with the Outlook object model, and it has been a while since I've VBA'd - I appreciate any help. I am adapting someone else's Excel VBA to scrape a shared Outlook mailbox (I need the results in Excel, so that works for me).

The code currently works on the main inbox folder (it pulls all the emails in the inbox), but I'd like to scrape all subfolders as well (there may be multiple levels of subfolders in the shared Outlook inbox).

Fiddling with the code and other online examples, I can get all the top-level list of mailboxes (mine, and those shared with me). I can also get the top level items within the shared mailbox (inbox, sent, drafts, archive). I just can't figure out the syntax to get the subfolders of the shared inbox.

Windows, local install of office. Everything is x64.

Thank you for any assistance/advice!

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim mFolder As MAPIFolder
Dim olParentFolder As MAPIFolder
Dim sFolder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Dim olNS As Outlook.Namespace
Dim subfolder As Folder
Dim objItm As Object

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")


'**** this bit is added to get a shared email ******
    Set objOwner = OutlookNamespace.CreateRecipient("name@company.com")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set mFolder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox) 'can use olFolderInbox or olFolderSentMail
        
    End If
    
    'failed attempts to try to find a way to reference the subfolders
    Debug.Print mFolder.Name
    'Debug.Print mFolder.objItm.Count
    
    'Set subfolder = mFolder.Folders(1)
    'Debug.Print subfolder.Name
    
    For Each myObj In OutlookNamespace.Folders
    Debug.Print myObj.Name
    Next
    
    
   ' Failed attempt
    Dim olFolderA As Outlook.MAPIFolder
    Dim olFolderB As Outlook.MAPIFolder
    For Each olFolderA In mFolder.Folders
        Debug.Print olFolderA.FolderPath, olFolderA.Items.Count, olFolderA.Folders.Count
        For Each olFolderB In olFolderA.Folders
            Debug.Print olFolderB.FolderPath, olFolderB.Items.Count
        Next
    Next

'more fail    
Dim objItems As Variant
Set objItems = mFolder.Parent.Folders
    
    'Dim f As Outlook.MAPIFolder
    For Each f In mFolder.Parent.Folders
        'DrillDown f
        Debug.Print f.FolderPath, f.Items.Count
    Next

    
'    For Each objItm In mFolder.Items
'        Debug.Print objItm.Parent
'    Next
'***************************************************

'Write mail to spreadsheet - create named range, from and to dates on the spreadsheet
i = 1


'On Error Resume Next
'For Each Folder In Namespace.Folders
'    For Each subfolder In Folder.Folders
Debug.Print Folder.Name '& " | " & subfolder.Name 'still fail

For Each OutlookMail In Folder.Items

        Sheet2.Range("A" & i).Value = i
        Sheet2.Range("B" & i).Value = OutlookMail.ReceivedTime
        Sheet2.Range("C" & i).Value = OutlookMail.SenderName
        Sheet2.Range("D" & i).Value = OutlookMail.To
        Sheet2.Range("E" & i).Value = OutlookMail.Subject
        Sheet2.Range("F" & i).Value = OutlookMail.Body
        
        OriginalBodyFull = OutlookMail.Body
        
        i = i + 1
    'End If
Next OutlookMail

    'Next subfolder
'Next Folder
'On Error GoTo 0

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

I found one thread where the shared mailbox settings seemed to be part of the problem/solution, so adding that here as well

Does this answer your question? [Can I iterate through all Outlook emails in a folder including sub-folders?](https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders) — niton, Apr 03 '23 at 16:09
Thank you - I think this is a shared mailbox syntax problem - I can get recursion to work fine on my personal mailbox. Added this to the code above and no joy (nothing prints to console) For Each fldr In mFolder.Folders Debug.Print fldr.Name 'nothing printed to console Next — K ATL, Apr 04 '23 at 12:48

score 0 · Answer 1 · answered Apr 03 '23 at 16:23

Like this perhaps (untested):

Sub GetFromOutlook()

    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim mFolder As MAPIFolder
    Dim olParentFolder As MAPIFolder
    Dim sFolder As MAPIFolder
    Dim OutlookMail As Variant, objOwner As Object
    Dim i As Long
    Dim subfolder As folder, colFolders As New Collection, fld As MAPIFolder
    Dim objItm As Object
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    '**** this bit is added to get a shared email ******
    Set objOwner = OutlookNamespace.CreateRecipient("name@company.com")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set mFolder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
    End If
    
    colFolders.Add mFolder 'add the starting folder to the collection
    
    Do While colFolders.Count > 0  'loop while have folders to process
        Set fld = colFolders(1)    'grab a folder from the collection
        colFolders.Remove 1        ' then remove it from the collection
        For Each OutlookMail In fld.Items
            'maybe add a check for only mail items?
            Sheet2.Cells(i, "A").Resize(1, 6).Value = _
              Array(i, OutlookMail.ReceivedTime, OutlookMail.SenderName, _
                   OutlookMail.To, OutlookMail.Subject, OutlookMail.Body)
            i = i + 1
        Next OutlookMail
        
        For Each sFolder In fld.Folders
            colFolders.Add sFolder
        Next sFolder
    Loop
    
End Sub

Tim, thank you for the reply and sample! I did have to filter for mail items. When I added Debug.Print colFolders.Count right after colFolders.Add mFolder, it only returns a value of 1. It does export the inbox contents but still doesn't pick up the inbox subfolders I see in Outlook — K ATL, Apr 04 '23 at 12:50

score 0 · Answer 2 · answered Apr 04 '23 at 15:48

No idea why it mattered to VBA but I disabled cached mode for this mailbox in Outlook... and now my Excel VBA code sees the shared mailbox subfolders.

This gets me past that roadblock, I'll create a new thread if I have any additional (different) questions

Thank you to Tim and Niton for taking the time to reply with suggestions!

Recursive folder search in shared mailbox

2 Answers2