title: Why can't I access subfolders of a shared mailbox?
body: <p>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:<br>
  1. Moves the message to a specified subfolder<br>
  2. Saves all Excel attachments to a Desktop folder.</p>
  
  <p>After doing considerable research I came up with the following code and pasted into ThisOutlookSession:</p>
  
  <pre class="lang-vb prettyprint-override"><code>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") &gt; 0 Then
          For Each att In item.Attachments
              If InStr(att.DisplayName, ".xlsx") Then
                  FileName = "folderpath to desktop location\" &amp; 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 &amp; " - " &amp; Err.Description
  Resume ProgramExit
  End Sub
  </code></pre>
  
  <p>I get the following error message when I try to run the code manually (F5) or when Outlook is restarted:</p>
  
  <blockquote>
    <p>Run-time error '-2147221233 (8004010f)':<br>
    The attempted operation failed.<br>
    An object could not be found.</p>
  </blockquote>
  
  <p>The line where the running is stopped is when the specific subfolder (<code>oMoveTarget</code>) is set in <code>Private Sub Application_Startup()</code>.</p>
  
  <p>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.</p>
  
  <p>I am allowed to access and run a script on a shared mailbox, but I am denied access to its subfolders.</p>