Why can't I access subfolders of a shared mailbox? - vba

Question

My goal is to create a VBA script that fires when a new e-mail arrives to a shared mailbox and does the following things if the title contains specific text:
1. Moves the message to a specified subfolder
2. Saves all Excel attachments to a Desktop folder.
After doing considerable research I came up with the following code and pasted into ThisOutlookSession:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim myOlApp As Outlook.Application
Dim myNms As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myitem As Object
Dim myRecipient As Outlook.Recipient
Dim myExplorer As Outlook.Explorer
Dim SharedFolder As Outlook.MAPIFolder
Dim oMoveTarget As Outlook.MAPIFolder
Set myOlApp = CreateObject("Outlook.Application")
Set myNms = myOlApp.GetNamespace("MAPI")
Set myFolder = myNms.GetDefaultFolder(olFolderInbox)
Set myExplorer = myOlApp.ActiveExplorer
Set myExplorer.CurrentFolder = myFolder
Set myRecipient = myNms.CreateRecipient("shared mailbox")
Set SharedFolder = myNms.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set oMoveTarget = SharedFolder.Folders("specific subfolder where messages should be moved")
Set Items = SharedFolder.Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim att As Attachment
Dim FileName As String
Dim intFiles As Integer
Dim myOlApp As Outlook.Application
Dim myNms As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myitem As Object
Dim myRecipient As Outlook.Recipient
Dim myExplorer As Outlook.Explorer
Dim SharedFolder As Outlook.MAPIFolder
Dim oMoveTarget As Outlook.MAPIFolder
If TypeName(item) = "MailItem" Then
Set Msg = item
If InStr(1, item.Subject, "specific text in subject") > 0 Then
For Each att In item.Attachments
If InStr(att.DisplayName, ".xlsx") Then
FileName = "folderpath to desktop location\" & Trim(att.FileName)
att.SaveAsFile FileName
intFiles = intFiles + 1
End If
Next
item.Move oMoveTarget
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I get the following error message when I try to run the code manually (F5) or when Outlook is restarted:
Run-time error '-2147221233 (8004010f)':
The attempted operation failed.
An object could not be found.
The line where the running is stopped is when the specific subfolder (oMoveTarget) is set in Private Sub Application_Startup().
If I omit (or comment out) the reference to a subfolder, the script works: Excel attachments from incoming e-mails to the shared mailbox with a specific subject are saved.
I am allowed to access and run a script on a shared mailbox, but I am denied access to its subfolders.

Answer 1

Is "Download shared folders" check box checked on the Advanced tab of your Exchange account properties dialog?
Try to uncheck it.