Outlook object model (VBA) question
Please note this is a repost, I originally posted in MS Answers public forums and the moderator directed me here.
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