This post is for Chris Bull who asked for some modifications to the code in my post titled Exporting Outlook Message Counts to Excel. Chris needs to export message counts for messages in two public folders that meet specific conditions. Here’s how Chris explained it to me in his comment.
I need to Create an Excel spreadsheet which will count the total number of ‘unflagged’ messages in two named public folders as well as the number of ‘unflagged’ messages over 7 days old. It would be useful to tag this with the date the counts were generated. Ideally I would like this to be done automatically on a weekly basis.
Sorry, to clarify there are people who mark emails with a flag and others who mark them with a tick. So really I need ‘unflagged and unticked’ as the criteria!
In order to meet Chris’ requirements I modified the code from my original post by
- Adding the ability to pass two Outlook folder paths instead of one.
- Adding the necessary conditional statements to determine if each item in the folder is flagged or not.
- Changing the output to write the date and the four counts, two for each folder, to the spreadsheet.
I tested the code on my system and verified the counts. They were correct. Chris will need to test it on his system to ensure it’s working properly before placing it into production.
One additional note. For those of you who may not be familiar with Outlook folder paths, here’s how they work. A folder path in Outlook is essentially the same as a folder path in the file system. The one difference being that Outlook folder paths do not include a drive letter. The path to a folder is a list of all the folders from the root to the target folder with each folder name separated from the preceding folder name by a backslash (i.e. \). Consider the following folder structure:
Mailbox - Doe, John - Calendar - Inbox - Tasks Personal Folders + Marketing + Proposals + Reviews + Projects + Project 1 + Project 2 Public Folders - John.Doe@company.com + All Public Folders + Projects + Project Blue + Project Green
The path to “Inbox” is “Mailbox – Doe, John\Inbox”.
The path to “Reviews” is “Personal Folders\Marketing\Reviews”.
The path to “Project 1” is “Personal Folders\Projects\Project 1”.
The path to “Project Green” is ” Public Folders – John.Doe@company.com\All Public Folders\Projects\Project Green”
- Outlook 2007 – 2010.
- Any version of Windows.
- The spreadsheet(s) must already exist.
- The computer must be on for the task scheduler to function.
- Open Notepad.
- Copy the code below and paste it into Notepad.
- Edit the code as needed. I’ve included comments where changes can/should be made.
- Save the file with a .vbs extension. You can name it anything you want.
- Create a scheduled task that runs periodically. You can set the frequency to whatever you want.
- Set the task to run this script.
'Constants Const olNoFlag = 0 Const olMail = 43 'Declare some variables Dim olkApp, olkSes 'Connect to Outlook Set olkApp = CreateObject("Outlook.Application") Set olkSes = olkApp.GetNamespace("MAPI") olkSes.Logon olkApp.DefaultProfileName 'Call the export process once for each folder count to be exported 'Format is ExportMessageCountToExcel <Path to First Outlook Folder>, < Path to Second Outlook Folder >, <Path and filename of the Excel file to export to>, <Number of the sheet the count goes on> 'The following lines are examples. Edit them as needed. Add additional lines as desired. ExportMessageCountToExcel "Mailbox - Doe, John\Inbox", "Projects\Project1", "c:\Users\jdoe\Documents\Message Counts.xlsx", 1 'Disconnect from Outlook olkSes.Logoff Set olkSes = Nothing Set olkApp = Nothing WScript.Quit Sub ExportMessageCountToExcel(strFolder1, strFolder2, strWorkbook, intSheet) Dim olkFld, olkItm, excApp, excWkb, excWks, lngRow, lngUnflaggedCount1, lngUnflaggedCount2, lngUnflaggedOver7Count1, lngUnflaggedOver7Count2 'Process the first folder Set olkFld = OpenOutlookFolder(strFolder1) For Each olkItm In olkFld.Items If olkItm.Class = olMail Then Select Case olkItm.FlagStatus Case olNoFlag If DateDiff("d", olkItm.ReceivedTime, Date) > 7 Then lngUnflaggedOver7Count1 = lngUnflaggedOver7Count1 + 1 End If lngUnflaggedCount1 = lngUnflaggedCount1 + 1 End Select End If Next 'Process the second folder Set olkFld = OpenOutlookFolder(strFolder2) For Each olkItm In olkFld.Items If olkItm.Class = olMail Then Select Case olkItm.FlagStatus Case olNoFlag If DateDiff("d", olkItm.ReceivedTime, Date) > 7 Then lngUnflaggedOver7Count2 = lngUnflaggedOver7Count2 + 1 End If lngUnflaggedCount2 = lngUnflaggedCount2 + 1 End Select End If Next 'Write the data to the spreadsheet Set excApp = CreateObject("Excel.Application") Set excWkb = excApp.Workbooks.Open(strWorkbook) Set excWks = excWkb.Worksheets(intSheet) lngRow = excWks.UsedRange.Rows.Count If lngRow = 1 Then If excWks.Cells(lngRow,1) <> "" Then lngRow = lngRow + 1 End If Else lngRow = lngRow + 1 End If excWks.Cells(lngRow, 1) = Date excWks.Cells(lngRow, 2) = lngUnflaggedCount1 excWks.Cells(lngRow, 3) = lngUnflaggedOver7Count1 excWks.Cells(lngRow, 4) = lngUnflaggedCount2 excWks.Cells(lngRow, 5) = lngUnflaggedOver7Count2 'Clean-up the objects Set excWks = Nothing excWkb.Close True Set excWkb = Nothing excApp.Quit Set excApp = Nothing Set olkFld = Nothing Set olkItm = nothing End Sub Function OpenOutlookFolder(strFolderPath) Dim arrFolders, varFolder, bolBeyondRoot On Error Resume Next If strFolderPath = "" Then Set OpenOutlookFolder = Nothing Else Do While Left(strFolderPath, 1) = "\" strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1) Loop arrFolders = Split(strFolderPath, "\") For Each varFolder In arrFolders Select Case bolBeyondRoot Case False Set OpenOutlookFolder = olkApp.Session.Folders(varFolder) bolBeyondRoot = True Case True Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder) End Select If Err.Number <> 0 Then Set OpenOutlookFolder = Nothing Exit For End If Next End If On Error GoTo 0 End Function