Click here to Skip to main content
15,569,840 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
I wish to get the number of mail items in each of our company's shared mailboxes.
My spreadsheet has in column A a list of all such mailboxes. I want to put the number of mail items into column B.
My code:-

Sub HowManyEmails()
Dim objOL As Object
Dim objNS As Object
Dim objFolder As MAPIFolder
Dim EmailCount As Integer
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
ThisRow = 1
While ThisRow < 999
    Range("A" & ThisRow).Select
    ThisFolder = ActiveCell.Value
    ThisFolder = Trim(ThisFolder)
    If ThisFolder = "" Then
        Exit Sub
        Set objFolder = objNS.Folders(ThisFolder)
        EmailCount = objFolder.Items.Count
        ThisRow = ThisRow + 1
        Range("B" & ThisRow).Select
        ActiveCell.Value = EmailCount
    End If
End Sub

The line after the Else "Set objFolder = objNS.Folders(ThisFolder)" gives a run time error '-2147221233 (8004010f)'.
In short, how to I access the shared folders? Is there a folder name for the store where shared folders are placed in Office 365?

What I have tried:

I've found many pages referring to this problem so have used various alternative ways of coding it but get the same result.
Updated 11-Nov-19 6:58am
CHill60 11-Nov-19 8:32am    
What was the full error message?
When you debug is the value of objNS Nothing?
What is the content of ThisFolder - does that folder name actually exist?

1 solution

That error means that the folder does not exist in that "area" of Outlook.

If you debug your code and observe the contents of objNS you will realise that it contains the list of mailboxes, not the list of folders within a mailbox.

You need to "point" to the appropriate mailbox first, then get the list of folders e.g.
Dim objItems As Variant
Set objItems = Session.GetDefaultFolder(olFolderInbox).Parent.Folders
There are methods for finding other mailboxes (shared, invite etc) described here - Working with VBA and non-default Outlook Folders[^]

You will still need to handle this error appropriately as you are relying entirely on someone entering the name of the folder correctly. There are other issues with your code too …

* You should fully qualify the range that you are using e.g.
ThisWorkbook.Sheets(1).Range("A" & ThisRow).Value
* You should avoid using ActiveCell ... why use two lines of code when one will do but importantly other code or user actions could "grab" the ActiveCell.
Range("B" & ThisRow).Select
ActiveCell.Value = EmailCount
ThisWorkbook.Sheets(1).Range("B" & ThisRow).Value = EmailCount
* You increment ThisRow before you update the count onto the worksheet so everything will be offset by 1

Personally I would have used a For Each loop rather than relying on a list being kept up to date and you will probably have to have a recursive call to handle sub-folders.

Have a look at vba - Can I iterate through all Outlook emails in a folder including sub-folders? - Stack Overflow[^]

Probably something like the following - although note I have not tested this fully
Sub HowManyEmails()
    Dim objOL As Object
    Set objOL = CreateObject("Outlook.Application")
    Dim objNS As Object
    Set objNS = objOL.GetNamespace("MAPI")
    Dim EmailCount As Integer
    Dim ThisRow As Integer
    ThisRow = 0
    Dim count As Long
    Dim objFolder As Variant
    For Each objFolder In objNS.Folders
        count = 0
        ThisRow = ThisRow + 1
        ThisWorkbook.Sheets(1).Range("A" & ThisRow).Value = objFolder.Name
        ThisWorkbook.Sheets(1).Range("B" & ThisRow).Value = objFolder.Items.count
        count = count + HowManyEmailsInFolder(objFolder)
        Debug.Print objFolder.Name
End Sub
Private Function HowManyEmailsInFolder(ByVal oParent As Outlook.MAPIFolder) As Long

    Dim oFolder As Outlook.MAPIFolder
    Dim oMail As Outlook.MailItem
    Dim numEmails As Long
    numEmails = numEmails + oParent.Items.count

    If (oParent.Folders.count > 0) Then
        For Each oFolder In oParent.Folders
            numEmails = numEmails + HowManyEmailsInFolder(oFolder)
    End If
    HowManyEmailsInFolder = numEmails
End Function
Share this answer
ormonds 11-Nov-19 15:40pm    
Thank you, I will work through this today.
There are no subfolders, and the list in column A is correct, it was output to text from a Powershell command listing all folders.
ormonds 11-Nov-19 16:07pm    
That worked, but not quite in the way I expected - it listed all objects on my personal machine including those shared folders I am a delegate on. I shall log another question about how to get all public folders and only them - I am Exchange Admin so it should be possible.
Thank you for your help.
CHill60 12-Nov-19 3:47am    
Good luck, glad I could help.
Unfortunately because of my set up here I can't help further with that level of detail - hence not being able to fully test the stuff I did do.
It might be worth putting a watch on objFolder and having a look at the properties - from memory there is a way to distinguish public folders but the detail escapes me.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900