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

问题

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.

回答1:

Is "Download shared folders" check box checked on the Advanced tab of your Exchange account properties dialog?

Try to uncheck it.

来源：https://stackoverflow.com/questions/30155678/why-cant-i-access-subfolders-of-a-shared-mailbox

标签

vba

outlook