如何使用Excel VBA在Outlook中指定嵌套的文件夹

我需要使用Excel VBA在Outlook中指定一个嵌套文件夹的帮助。 我将发布我在下面使用的代码。

我能够指定“收件箱”文件夹，但是当我尝试指定“收件箱”文件夹内的文件夹时，代码将返回“没有这样的文件夹”消息。

有谁知道这是为什么发生在我身上？ 如果是的话，我该如何解决？

Option Explicit Sub HowManyEmails() Dim objOutlook As Object, objnSpace As Object, objFolder As Object Dim EmailCount As Integer Set objOutlook = CreateObject("Outlook.Application") Set objnSpace = objOutlook.GetNamespace("MAPI") On Error Resume Next Set objFolder = objnSpace.Folders("NoctalkSW").Folders("Inbox") If Err.Number <> 0 Then Err.Clear MsgBox "No such folder." Exit Sub End If EmailCount = objFolder.Items.Count Set objFolder = Nothing Set objnSpace = Nothing Set objOutlook = Nothing [B2].Value = EmailCount On Error Resume Next Set objFolder = objnSpace.Folders("NoctalkSW").Folders("Inbox").Folders("COMPLETED") If Err.Number <> 0 Then Err.Clear MsgBox "No such folder." Exit Sub End If EmailCount = objFolder.Items.Count Set objFolder = Nothing Set objnSpace = Nothing Set objOutlook = Nothing [B3].Value = EmailCount End Sub 

Answer 1

你有没有尝试debugging代码？ 无论如何，尝试使用下面的代码：

 Option Explicit Sub HowManyEmails() Dim objOutlook As Object, objnSpace As Object, objFolder As Object Dim EmailCount As Integer Set objOutlook = CreateObject("Outlook.Application") Set objnSpace = objOutlook.GetNamespace("MAPI") On Error Resume Next Set objFolder = objnSpace.Folders("NoctalkSW").Folders("Inbox") If Err.Number <> 0 Then Err.Clear MsgBox "No such folder." Exit Sub End If EmailCount = objFolder.Items.Count Set objFolder = Nothing Set objOutlook = Nothing [B2].Value = EmailCount On Error Resume Next Set objFolder = objnSpace.Folders("NoctalkSW").Folders("Inbox").Folders("COMPLETED") If Err.Number <> 0 Then Err.Clear MsgBox "No such folder." Exit Sub End If EmailCount = objFolder.Items.Count Set objFolder = Nothing Set objnSpace = Nothing Set objOutlook = Nothing [B3].Value = EmailCount End Sub 

您也可以尝试遍历文件夹，请参阅如何：枚举文件夹 。

Answer 2

如果要访问共享的收件箱和子文件夹，请使用GetSharedDefaultFolder方法

_{GetSharedDefaultFolder方法返回一个MAPIFolder对象，该对象表示指定用户的指定默认文件夹。 在委派scheme中使用此方法，其中一个用户已委派其他用户访问一个或多个默认文件夹。}

---

代码示例

 Option Explicit Const olFolderInbox = 6 Sub HowManyEmails() Dim olApp As Object Dim olNs As Object Dim Inbox As Object Dim SubFolder As Object Dim Recip As Object Set olApp = CreateObject("Outlook.Application") Set olNs = olApp.GetNamespace("MAPI") Set Recip = olNs.CreateRecipient("[e-mail]") ' Share address Recip.Resolve Set Inbox = olNs.GetSharedDefaultFolder(Recip, olFolderInbox) ' Inbox [B2].Value = Inbox.Items.Count Set SubFolder = Inbox.Folders("COMPLETED") ' subfolder [B3].Value = SubFolder.Items.Count Set olApp = Nothing Set olNs = Nothing Set Inbox = Nothing Set SubFolder = Nothing Set Recip = Nothing End Sub