Outlook question

Total

#1

HI,
I want to count the number of all the items in my outlook folders. And every folder includes several subfolders. I can change folder properties to set it to show total number of items. But it doesn’t contain the items in subfolders.

How can I quickly count the number of all the items in all folders with subfolders? Do I have to do that manually?


#2

You can use VBA to counting and export the results into an Excel file. Here is a macro I find.

Public strExcelFile As String
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet

Sub Export_CountOfItems_InEachFolder_toExcel()
Dim objSourcePST As Outlook.Folder
Dim objFolder As Outlook.Folder

'Create a new Excel file
Set objExcelApp = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
objExcelWorksheet.Cells(1, 1) = "Folder"
objExcelWorksheet.Cells(1, 2) = "Count Items"

'Select a source PST file
Set objSourcePST = Outlook.Application.Session.PickFolder

For Each objFolder In objSourcePST.folders
    Call ProcessFolders(objFolder)
Next

'Fit the columns from A to B
objExcelWorksheet.Columns("A:B").AutoFit

strExcelFile = "E:\Outlook\" & objSourcePST.Name & " Folder Items Count (" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ").xlsx"
objExcelWorkbook.Close True, strExcelFile

MsgBox "Complete!", vbExclamation

End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
Dim objItem As Object
Dim lCurrentFolderItemCount As Long
Dim nLastRow As Integer

lCurrentFolderItemCount = objCurrentFolder.Items.Count

nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1

'Add the values into the columns
objExcelWorksheet.Range("A" & nLastRow) = objCurrentFolder.FolderPath
objExcelWorksheet.Range("B" & nLastRow) = lCurrentFolderItemCount

If objCurrentFolder.folders.Count > 0 Then
   For Each objSubfolder In objCurrentFolder.folders
       Call ProcessFolders(objSubfolder)
   Next
End If

End Sub

More details here

Good luck