Outlook object model (VBA) question

KERATL 5 Reputation points
2023-03-31T11:30:06.1+00:00

Please note this is a repost, I originally posted in MS Answers public forums and the moderator directed me here.

https://answers.microsoft.com/en-us/outlook_com/forum/all/outlook-object-model-vba-question/9ceeccaf-98f6-4b75-9e56-b982813b087c


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. Posting here because this request is request is core to Outlook (the object model), not Excel.

The code currently works on the main inbox folder, but I'd like to scrape all subfolders as well (there may be multiple levels of subfolders in the shared Outlook mailbox). There is some subfolder code but it is commented out because I couldn't get it working

Windows, local install of office. I think everything is x64.

Sub GetFromOutlook() 

Dim OutlookApp As Outlook.Application 
Dim OutlookNamespace As Namespace 
Dim Folder As MAPIFolder 
Dim OutlookMail As Variant 
Dim i As Integer 
Dim olNS As Outlook.Namespace 
Dim subfolder As Folder 
 
Set OutlookApp = New Outlook.Application 
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI") 
 
'**** get the shared mailbox ****** 
    Set objOwner = OutlookNamespace.CreateRecipient("******@confidential.com") 'real email replaced for this posting
    objOwner.Resolve 
    If objOwner.Resolved Then 
      Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox) 'can use olFolderInbox or olFolderSentMail 
    End If 
     
'    For Each Folder In Folder.Folders 
'        Debug.Print Folder.Name  'folder.folders.count=0, syntax or object model issue? 
'    Next 
'********************************** 
 
'Write mail to spreadsheet - create named range, from and to dates on the spreadsheet 
i = 1 
  
'For Each Folder In Namespace.Folders 
'    For Each subfolder In Folder.Folders 
'    Debug.Print Folder.Name '& " | " & subfolder.Name 
 
    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 'emails are all in the same format, I need info from the body
                                                       'I deleted the code block that extracts that info since it isn't
                                                       'relevant to the issue of searching subfolders
         
        'Sheet2.Range("I" & i).Value = Folder.Name & " | " & subfolder.Name 'need to capture the folder path for each email
        i = i + 1 
   Next OutlookMail 
 
    'Next subfolder 
'Next Folder 
 
Set Folder = Nothing 
Set OutlookNamespace = Nothing 
Set OutlookApp = Nothing 
 
 
End Sub
Outlook Windows Classic Outlook for Windows For business
{count} votes

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.