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

Question

我需要使用 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

您是否尝试调试代码？无论如何，尝试使用以下代码：

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

您也可以尝试遍历文件夹，请参阅How to: Enumerate Folders。

Answer 2

如果您想访问共享收件箱和子文件夹，请使用 GetSharedDefaultFolder Method

_{GetSharedDefaultFolder Method 返回表示指定用户的指定默认文件夹的 MAPIFolder 对象。此方法用于委派方案，其中一个用户已将一个或多个默认文件夹的访问权限委派给另一个用户。}

---

代码示例

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("0m3r@email.com") ' 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