How to specify nested folder in Outlook using Exce

Question

I need help specifying a nested folder in Outlook using Excel VBA. I will post the code I'm using below.

I'm able to specify the "Inbox" folder but when I try and specify a folder that is within the "Inbox" folder, the code comes back with the "No such folder" message.

Does anyone know why this is happening to me? If so, how can I fix it?

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

Did you try to debug the code? Anyway, try to use the following code:

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

Also you may try to iterate over folders, see How to: Enumerate Folders.

Answer 2

If you wanna access shared Inbox and subfolder then Work with GetSharedDefaultFolder Method

_{GetSharedDefaultFolder Method Returns a MAPIFolder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders.}

---

Code Example

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