为什么我无法访问共享邮箱的子文件夹? [英] Why can't I access subfolders of a shared mailbox?

问题描述

我的目标是创建一个 VBA 脚本，该脚本在新电子邮件到达共享邮箱时触发，并在标题包含特定文本时执行以下操作:
1. 将邮件移动到指定的子文件夹
2. 将所有 Excel 附件保存到桌面文件夹.

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.

经过大量研究后，我想出了以下代码并粘贴到 ThisOutlookSession 中:

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

当我尝试手动运行代码 (F5) 或重新启动 Outlook 时收到以下错误消息:

I get the following error message when I try to run the code manually (F5) or when Outlook is restarted:

运行时错误'-2147221233 (8004010f)':
尝试的操作失败.
找不到对象.

Run-time error '-2147221233 (8004010f)':
The attempted operation failed.
An object could not be found.

停止运行的行是在Private Sub Application_Startup()中设置特定子文件夹(oMoveTarget)时.

The line where the running is stopped is when the specific subfolder (oMoveTarget) is set in Private Sub Application_Startup().

如果我省略(或注释掉)对子文件夹的引用，脚本将起作用:从传入电子邮件到具有特定主题的共享邮箱的 Excel 附件将被保存.

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.

推荐答案

是否选中了 Exchange 帐户属性对话框的高级"选项卡上的下载共享文件夹"复选框?

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

尝试取消选中它.

这篇关于为什么我无法访问共享邮箱的子文件夹?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！