为什么我无法访问共享邮箱的子文件夹?
Why can't I access subfolders of a shared mailbox?
我的目标是创建一个 VBA 脚本,该脚本在新的 e-mail 到达共享邮箱时触发,并在标题包含特定文本时执行以下操作:
1. 将邮件移动到指定的子文件夹
2. 将所有 Excel 个附件保存到桌面文件夹。
经过大量研究后,我想出了以下代码并将其粘贴到 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 时收到以下错误消息:
Run-time error '-2147221233 (8004010f)':
The attempted operation failed.
An object could not be found.
运行ning停止的行是在Private Sub Application_Startup()
.
中设置特定子文件夹(oMoveTarget
)时
如果我省略(或注释掉)对子文件夹的引用,脚本会起作用:Excel 来自传入 e-mail 的附件到具有特定主题的共享邮箱被保存。
我可以访问和 运行 共享邮箱上的脚本,但我无法访问其子文件夹。
是否在 Exchange 帐户属性对话框的“高级”选项卡上选中了 "Download shared folders" 复选框?
尝试取消选中它。
我的目标是创建一个 VBA 脚本,该脚本在新的 e-mail 到达共享邮箱时触发,并在标题包含特定文本时执行以下操作:
1. 将邮件移动到指定的子文件夹
2. 将所有 Excel 个附件保存到桌面文件夹。
经过大量研究后,我想出了以下代码并将其粘贴到 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 时收到以下错误消息:
Run-time error '-2147221233 (8004010f)':
The attempted operation failed.
An object could not be found.
运行ning停止的行是在Private Sub Application_Startup()
.
oMoveTarget
)时
如果我省略(或注释掉)对子文件夹的引用,脚本会起作用:Excel 来自传入 e-mail 的附件到具有特定主题的共享邮箱被保存。
我可以访问和 运行 共享邮箱上的脚本,但我无法访问其子文件夹。
是否在 Exchange 帐户属性对话框的“高级”选项卡上选中了 "Download shared folders" 复选框?
尝试取消选中它。