How to reference a subfolder of a shared mailbox? - vba

Question

I want to save Outlook attachments to a shared drive.
The below script saves attachments from my own inbox. I want to save attachments from a subfolder of a shared mailbox.
Private WithEvents InboxItems As Outlook.Items
Const attPath As String = "T:\London File3 Group\Client Reporting\Test\ABI Daily\"
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
Set InboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem: Set Msg = Item
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Filename As String
If Not TypeName(Msg) = "MailItem" Then Exit Sub
If (Msg.Subject Like "*Trade*") Or (Msg.Subject Like "*Trades*") Or _
(Msg.Subject Like "*Article 59*") Or (Msg.Subject Like "*Val*") Or _
(Msg.Subject Like "*Valuation*") Or (Msg.Subject Like "*Trading*") Or _
(Msg.Subject Like "*St James*") Then
Set myAttachments = Item.Attachments
Filename = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Filename
Msg.UnRead = False
End If
End Sub

Answer 1

Work with GetSharedDefaultFolder Method which Returns a MAPIFolder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders
Example
Private WithEvents InboxItems As Outlook.Items
Const attPath As String = "T:\London File3 Group\Client Reporting\Test\ABI Daily\"
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
Dim ShrdRecip As Outlook.Recipient: Set ShrdRecip = objectNS.CreateRecipient("0m3r#email.com")
Set InboxItems = GetSharedDefaultFolder(ShrdRecip, olFolderInbox).Items
End Sub
Edit
Example for subfolder
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim ShrdRecip As Outlook.Recipient
Dim Inbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set ShrdRecip = olNs.CreateRecipient("0m3r#email.com")
Set Inbox = olNs.GetSharedDefaultFolder(ShrdRecip, olFolderInbox) _
.Folders("FolderName")
Set Items = Inbox.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Debug.Print Item.Subject ' print on Immediate window
End If
End Sub