Count Emails in a Shared Mailbox by date and Export to Excel.

sudoreaper

New Member
Joined
Mar 3, 2021
Messages
1
Office Version
  1. 2016
Platform
  1. Windows
Hey guys!

New to this forum, and trying to slap together a project to make my mornings a bit easier.

I'm looking to count all of the email in a folder and all of its subfolders, and give me a count of each date in the folder. As of now, I have them exporting to excel and giving me a count, but it does not break the count down by date. Ideally, I would like to exclude any emails with today's date from the counts, as emails that come in are not assigned until the next day, and then for each folder have a column that displays the oldest date in that folder/subfolder.

I would even take this data as a messagebox though excel is prefered.

Any help anyone could provide would be very appreciated.

Here is the code I'm working with:

Sub Morning_Counts()
Dim xSourceFolder As Outlook.Folder, xSubFolder As Outlook.Folder
Dim xFilePath As String
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
On Error Resume Next
Set xExcelApp = New Excel.Application
Set xWb = xExcelApp.Workbooks.Add
Set xWs = xWb.Sheets(1)
xWs.Cells(1, 1) = "Folder"
xWs.Cells(1, 2) = "Count Items"
xWs.Cells(1, 3) = "Last Count"
xWs.Cells(1, 4) = "Analyst"
xWs.Cells(2, 4) = "Chris Stein"
xWs.Cells(2, 3) = Format(Now, "mm/dd/yyyy HH:mm:ss")
Set xSourceFolder = Outlook.Application.Session.PickFolder
If xSourceFolder = nill Then
xWb.Close False
xExcelApp.Quit
Exit Sub
End If
For Each xSubFolder In xSourceFolder.Folders
Call ProcessFolders(xWs, xSubFolder)
Next
xWs.Columns("A:B").AutoFit
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a Folder:", 0, 0)
If TypeName(xFolder) = "Nothing" Then
xWb.Close False
xExcelApp.Quit
Exit Sub
End If
Set xFolderItem = xFolder.self
xFilePath = xFolderItem.Path & "\"
xFilePath = xFilePath & "Morning Counts.xlsx"
xWb.Close True, xFilePath
xExcelApp.Quit
Set xShell = Nothing
MsgBox "Morning Counts have been updated. Please refresh the report.", vbExclamation, "Operations"
End Sub
Sub ProcessFolders(ByVal Ws As Worksheet, ByVal xCurFolder As Outlook.Folder)
Dim xSubFld As Folder
Dim xItemCount As Long
Dim xRow As Integer
xItemCount = xCurFolder.Items.Count
xRow = Ws.UsedRange.Rows.ReceivedTime.Count + 1
Ws.Cells(xRow, 1) = xCurFolder.FolderPath
Ws.Cells(xRow, 2) = xItemCount
If xCurFolder.Folders.Count > 0 Then
For Each xSubFld In xCurFolder.Folders
Call ProcessFolders(Ws, xSubFld)
Next
End If
End Sub
 

Attachments

  • Capture.PNG
    Capture.PNG
    58.7 KB · Views: 24

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
139
Office Version
  1. 365
Platform
  1. Windows
Hey guys!

New to this forum, and trying to slap together a project to make my mornings a bit easier.

I'm looking to count all of the email in a folder and all of its subfolders, and give me a count of each date in the folder. As of now, I have them exporting to excel and giving me a count, but it does not break the count down by date. Ideally, I would like to exclude any emails with today's date from the counts, as emails that come in are not assigned until the next day, and then for each folder have a column that displays the oldest date in that folder/subfolder.

I would even take this data as a messagebox though excel is prefered.

Any help anyone could provide would be very appreciated.

Here is the code I'm working with:

Sub Morning_Counts()
Dim xSourceFolder As Outlook.Folder, xSubFolder As Outlook.Folder
Dim xFilePath As String
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
On Error Resume Next
Set xExcelApp = New Excel.Application
Set xWb = xExcelApp.Workbooks.Add
Set xWs = xWb.Sheets(1)
xWs.Cells(1, 1) = "Folder"
xWs.Cells(1, 2) = "Count Items"
xWs.Cells(1, 3) = "Last Count"
xWs.Cells(1, 4) = "Analyst"
xWs.Cells(2, 4) = "Chris Stein"
xWs.Cells(2, 3) = Format(Now, "mm/dd/yyyy HH:mm:ss")
Set xSourceFolder = Outlook.Application.Session.PickFolder
If xSourceFolder = nill Then
xWb.Close False
xExcelApp.Quit
Exit Sub
End If
For Each xSubFolder In xSourceFolder.Folders
Call ProcessFolders(xWs, xSubFolder)
Next
xWs.Columns("A:B").AutoFit
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a Folder:", 0, 0)
If TypeName(xFolder) = "Nothing" Then
xWb.Close False
xExcelApp.Quit
Exit Sub
End If
Set xFolderItem = xFolder.self
xFilePath = xFolderItem.Path & "\"
xFilePath = xFilePath & "Morning Counts.xlsx"
xWb.Close True, xFilePath
xExcelApp.Quit
Set xShell = Nothing
MsgBox "Morning Counts have been updated. Please refresh the report.", vbExclamation, "Operations"
End Sub
Sub ProcessFolders(ByVal Ws As Worksheet, ByVal xCurFolder As Outlook.Folder)
Dim xSubFld As Folder
Dim xItemCount As Long
Dim xRow As Integer
xItemCount = xCurFolder.Items.Count
xRow = Ws.UsedRange.Rows.ReceivedTime.Count + 1
Ws.Cells(xRow, 1) = xCurFolder.FolderPath
Ws.Cells(xRow, 2) = xItemCount
If xCurFolder.Folders.Count > 0 Then
For Each xSubFld In xCurFolder.Folders
Call ProcessFolders(Ws, xSubFld)
Next
End If
End Sub
Hi

I am really new to this VBA, but it looks like what you are doing here is exactly what i am looking for.
unfortunately i can´t help you with your question, but hopefully you can help me :)

This VBA, is this running fro Outlook or is it running from Excel ?
Either way i am getting an error...


1631701211677.png


BR. Lars
 

Attachments

  • 1631701211753.png
    1631701211753.png
    30 KB · Views: 0

Forum statistics

Threads
1,144,389
Messages
5,724,073
Members
422,534
Latest member
ThiccNugg

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top