How to code in VBA to count the number of emails in shared subfolder of Outlook?

[JonasAdamski]

Hi Guys,

I want to get the number of emails in specific folders (multiple folders, 7 to be exact), I am not worried about the date or month. But a count of the emails in these folders is enough.

I also want the date of the last email in these sub folders. The folder is a shared folder that many employees have just like I do and we are supposed to process the data from this shared folder in Outlook.

Could someone please help me because I don't seem to make any progress. Thanks and have a nice day


I have found this code for now, but it only counts the number of emails in a specific folder and not in multiple folders. Also this does not give the date of the last email to me.


Sub count()
Dim objItems As Outlook.Items
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim strMonth As String
Dim dReceivedTime As Date
Dim strReceivedDate As String
Dim i, n As Long
Dim strMsg As String
Dim nPrompt As Integer

Dim NS As NameSpace
Dim folder As MAPIFolder

Set NS = Application.GetNamespace("MAPI")

Set folder = NS.Folders("abcgmail.com").Folders("Inbox") '.Folders("Subfolder").Folders("Subfolder")
Set objItems = folder.Items

'Set objItems = Outlook.Application.Posteingang

objItems.SetColumns ("ReceivedTime")
strMonth = InputBox("Enter the specific month.(Format: yyyy)", "Specify year")

If strMonth <> "" Then
n = 0
For i = 1 To objItems.count
If objItems.Item(i).Class = olMail Then
Set objMail = objItems.Item(i)
dReceivedTime = objMail.ReceivedTime
strReceivedDate = Format(dReceivedTime, "yyyy")
If strReceivedDate = strMonth Then
n = n + 1
End If
End If
Next i

strMsg = "You have received " & n & " emails on " & strMonth & "."
nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
Else
nPrompt = MsgBox("Please input the specific day!", vbExclamation)
End If
End Sub

 

[shknbk2]

Your folder/subfolder structure isn't stated, so I don't know how these subfolders you want to search are situated. This code below assumes that they are all subfolders at the same level as each other under an Inbox subfolder. Change it as needed.

I also put this code into Outlook to run it from there. You didn't say if you were running it from Excel or not. Your description doesn't specify why this would be run in Excel and not Outlook, but you could run it from Excel if you want to.

Sub count()
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
    Dim dReceivedTime As Date
    Dim strReceivedDate As String
    Dim i, n As Long
    Dim strMsg As String
    Dim nPrompt As Integer
    
    Dim NS As NameSpace
    Dim folder As MAPIFolder
    Dim subfolder As MAPIFolder
    Dim latestDate As Date
    
    Set NS = Application.GetNamespace("MAPI")
    
    Set folder = NS.GetDefaultFolder(olFolderInbox).Folders("Subfolder1")
    
    strMonth = InputBox("Enter the specific month.(Format: yyyy)", "Specify year")
    
    If strMonth <> "" Then
        n = 0
        For Each subfolder In folder.Folders
            Set objItems = subfolder.Items
            
            'Set objItems = Outlook.Application.Posteingang
            
'            objItems.SetColumns ("ReceivedTime")
            For i = 1 To objItems.count
                If objItems.Item(i).Class = olMail Then
                    Set objMail = objItems.Item(i)
                    dReceivedTime = objMail.ReceivedTime
                    strReceivedDate = Format(dReceivedTime, "yyyy")
                    If strReceivedDate = strMonth Then
                        If dReceivedTime > latestDate Then
                            latestDate = dReceivedTime
                        End If
                        n = n + 1
                    End If
                End If
            Next i
        Next subfolder
    
        strMsg = "You have received " & n & " emails on " & strMonth & "."
        strMsg = strMsg & vbCrLf & vbCrLf
        strMsg = strMsg & "The latest email was received on " & Format(latestDate, "mm/dd/yyyy") & "."
        nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
    Else
        nPrompt = MsgBox("Please input the specific day!", vbExclamation)
    End If
End Sub

 

[JonasAdamski]

Your folder/subfolder structure isn't stated, so I don't know how these subfolders you want to search are situated. This code below assumes that they are all subfolders at the same level as each other under an Inbox subfolder. Change it as needed.

I also put this code into Outlook to run it from there. You didn't say if you were running it from Excel or not. Your description doesn't specify why this would be run in Excel and not Outlook, but you could run it from Excel if you want to.

Sub count()
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
    Dim dReceivedTime As Date
    Dim strReceivedDate As String
    Dim i, n As Long
    Dim strMsg As String
    Dim nPrompt As Integer
   
    Dim NS As NameSpace
    Dim folder As MAPIFolder
    Dim subfolder As MAPIFolder
    Dim latestDate As Date
   
    Set NS = Application.GetNamespace("MAPI")
   
    Set folder = NS.GetDefaultFolder(olFolderInbox).Folders("Subfolder1")
   
    strMonth = InputBox("Enter the specific month.(Format: yyyy)", "Specify year")
   
    If strMonth <> "" Then
        n = 0
        For Each subfolder In folder.Folders
            Set objItems = subfolder.Items
           
            'Set objItems = Outlook.Application.Posteingang
           
'            objItems.SetColumns ("ReceivedTime")
            For i = 1 To objItems.count
                If objItems.Item(i).Class = olMail Then
                    Set objMail = objItems.Item(i)
                    dReceivedTime = objMail.ReceivedTime
                    strReceivedDate = Format(dReceivedTime, "yyyy")
                    If strReceivedDate = strMonth Then
                        If dReceivedTime > latestDate Then
                            latestDate = dReceivedTime
                        End If
                        n = n + 1
                    End If
                End If
            Next i
        Next subfolder
   
        strMsg = "You have received " & n & " emails on " & strMonth & "."
        strMsg = strMsg & vbCrLf & vbCrLf
        strMsg = strMsg & "The latest email was received on " & Format(latestDate, "mm/dd/yyyy") & "."
        nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
    Else
        nPrompt = MsgBox("Please input the specific day!", vbExclamation)
    End If
End Sub

Hey this didn't seem to work.

So the shared inbox is called 'A' then it further has an inbox called 'Inbox' and then two subfolders 'B' and 'C'. 'B' has three subfolders, lets say 'D', 'E', 'F'. and 'C' has a subfolder named 'G' and five more subfolders "H, I, J, K, L".

I want to count the number of emails in "D, E, F" and "H, I, J, K, L". I also want to know the date of the last email from these subfolders. The code will be executed in Outlook directly.

I have tried to make a layout of the shared inbox and its subfolders on a page for reference.

It would be great if you could help me because I have been stuck in this position and don't seem to make any progress.

 

[shknbk2]

I've changed the code so that it uses recursion. It can start with setting either "A" as the main folder or "Inbox". Either way should work. What the code does is go through each of the subfolders to determine which subfolder does not have any subfolders and counts the emails in that folder. That is, it only counts emails if the email parent folder (D, for example) doesn't have additional subfolders. So if you start with A, you can see that Inbox, B, C, and G have further subfolders; so any emails in these folders (if there are any) won't get counted. If you need them counted, let me know.

The code is below, but you need to find the information to set the starting folder. There are 2 options: putting in the folder name for A for Option 1, or using a folder EntryID in Option 2. I'm not sure if simply putting A inside the quotes will get you to the folder, or if there is yet a higher folder parent for A. If the code fails on "Set folder = NS.Folders("A")" (with A's actual name inside the quotes), then there is a higher folder. Tips on how to find it are after the code.

Sub count()
    Dim strMonth As String
    Dim strReceivedDate As String
    Dim n As Long
    Dim strMsg As String
    Dim nPrompt As Integer
    
    Dim NS As NameSpace
    Dim folder As MAPIFolder
    Dim latestDate As Date
    
    Set NS = Application.GetNamespace("MAPI")
    
    'Option 1
    Set folder = NS.Folders("A")
    Set folder = folder.Folders("Inbox")
    
    'Option 2
    'Set folder = NS.GetFolderFromID("00000000E4A5A357D015F34B93C0C7...")
    
    strMonth = InputBox("Enter the specific year.(Format: yyyy)", "Specify year")
    
    If strMonth <> "" Then
        ItemCount latestDate, n, strMonth, folder
        strMsg = "You have received " & n & " emails in " & strMonth & "."
        strMsg = strMsg & vbCrLf & vbCrLf
        strMsg = strMsg & "The latest email was received on " & Format(latestDate, "mm/dd/yyyy") & "."
        nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
    Else
        nPrompt = MsgBox("Please input the specific year!", vbExclamation)
    End If
End Sub

Sub ItemCount(ByRef latestDate As Date, ByRef n As Long, ByVal strMonth As String, ByVal f As folder)
    Dim subfolder As MAPIFolder
    Dim fCount As Integer, i As Integer
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim dReceivedTime As Date
    Dim strReceivedDate As String

    For Each subfolder In f.Folders
        If subfolder.Folders.count > 0 Then
            ItemCount latestDate, n, strMonth, subfolder
        Else
            Set objItems = subfolder.Items
            'Debug.Print subfolder.Name
            For i = 1 To objItems.count
                If objItems.Item(i).Class = olMail Then
                    Set objMail = objItems.Item(i)
                    dReceivedTime = objMail.ReceivedTime
                    strReceivedDate = Format(dReceivedTime, "yyyy")
                    If strReceivedDate = strMonth Then
                        If dReceivedTime > latestDate Then
                            latestDate = dReceivedTime
                        End If
                        n = n + 1
                    End If
                End If
            Next i
        End If
    Next
End Sub

Find EntryID:
Option 2 above allows you to use the EntryID of Inbox, for example. To find it, put the cursor in the Immediate Window (Ctrl + G) of the Visual Basic Editor and be prepared to type the following followed by Enter:

?ActiveExplorer.Selection.Item(1).Parent.Parent.Parent.Name

I say "be prepared" because you first have to select an email in the subfolder D. When this code is put into the Immediate Window and you hit Enter, the result that prints on the following line should be the Name of the email's "great-grandparent"; or in other words, the selection item's parent is D, D's parent is B, and B's parent is Inbox. By using Name in this line, we can make sure we are talking about the right folder.

Once we know that we are referring to the right folder (parent.parent.parent), we can get its EntryID by using:

?ActiveExplorer.Selection.Item(1).Parent.Parent.Parent.EntryID

This long string of numbers can be copied and pasted in the Option 2 "Set folder" line after making sure to uncomment this line and to comment out Option 1's lines.

Find A's parent:
If A is not a direct subfolder of NS, it might be a subfolder of the user's mailbox or of a Public Folder. To find the subfolders of NS in order to begin narrowing down which folder is the parent, you can use the Debugging tools.
1: Make the Locals window visible

2: Make sure the cursor is somewhere within the count() procedure and begin stepping through the code (F8) until after NS is set

3. Then, look in the locals window and expand NS and its Folders variable

4. The Items under Folders are the subfolders under my MAPI namespace, but yours will be different. For example, I have a few personal email accounts set up in Outlook as well as my work email and a Public folder. By opening up each Item, you can get verify its Name and continue searching under its Folders, etc. until you find the "A" subfolder.

If you use Option 1, use multiple "Set folder = folder.Folders" to drill down to the A folder (and maybe even Inbox under A) based on its parents on up through NS.

 

[JonasAdamski]

I actually want the count of the last subfolders which are D,E,F,G and H,I,J.

The following error was shown in the line : If subfolder.Folders.count > 0 Then

"object variable or With block variable not found"

 

[JonasAdamski]

I actually want the count of the last subfolders which are D,E,F,G and H,I,J.

The following error was shown in the line : If subfolder.Folders.count > 0 Then

"object variable or With block variable not found"

If I remove the second part of the codes it gives the error of sub or function not defined for the line : ItemCount latestDate, n, strMonth, folder

 

[shknbk2]

Which option of choosing the folder did you end up going with?

 

[shknbk2]

Also, are there any emails in the Inbox or in B and C? If there are, they should be ignored, right?

 

[JonasAdamski]

There are no emails in the folder B and C. They are just folders under which exist some sub folders, D,E,F, H,I,J where the emails are. and i want to count them.

Forget so many folders, just imagine there is one shared email, two folders inside it and one subfolder inside each one of them.

 

[shknbk2]

just imagine there is one shared email, two folders inside it and one subfolder inside each one of them

I don't know why the code above doesn't already work for this, then.

The following error was shown in the line : If subfolder.Folders.count > 0 Then

When the error happens, what folder is "subfolder" set to?