Reputation: 178
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
Upvotes: 1
Views: 2350
Reputation: 12499
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("[email protected]") ' 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
Upvotes: 1
Reputation: 49397
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.
Upvotes: 1