A lady or gentleman with the handle IT4577 has posted VBA code on spiceworks which can be used to find how many emails in an Outlook folder contain received dates that are specified in an Excel worksheet. The VBA code is copied below, but because of formatting issues with my Wix editor it may be necessary to copy the code from the spiceworks site.

The code should be entered into a module in Visual Basic for Excel, not Outlook. You need to have both Excel and Outlook open.

You'll have to change this part of the code.

On this line:

Set objFolder = objnSpace.Folders("Outlook Data File").Folders("Inbox").Folders("enron")

. . . specify the path to the folder in Outlook that contains the emails you need to review. In order to get the correct path right click on the folder in Outlook and select 'Properties'. On the General tab note the location of the folder being reviewed, in this example the one named, 'Enron'. The path is ' \\Outlook Data File\Inbox', but you need to list each folder in the path separately like this: Folders("Outlook Data File").Folders("Inbox").Folders("enron")

In an Excel file that has a worksheet named 'Sheet1' (as referenced in the VBA code) starting in cell A1 list dates in column A that you want to search for in the emails saved in the specified folder.

Run the macro, and the count of the number of emails with a matching received date will be generated in column B. It is not necessary for the received date field to be displayed in Outlook for this macro to work.

Sub HowManyDatedEmails() ' Set Variables Dim objOutlook As Object, objnSpace As Object, objFolder As Object Dim EmailCount As Integer, DateCount As Integer, iCount As Integer Dim myDate As Date Dim arrEmailDates() ' Get Outlook Object Set objOutlook = CreateObject("Outlook.Application") Set objnSpace = objOutlook.GetNamespace("MAPI") ' Get Folder Object On Error Resume Next Set objFolder = objnSpace.Folders("Outlook Data File").Folders("Inbox").Folders("enron") If Err.Number <> 0 Then Err.Clear MsgBox "No such folder." Set objFolder = Nothing Set objnSpace = Nothing Set objOutlook = Nothing Exit Sub End If ' Put ReceivedTimes in array EmailCount = objFolder.Items.Count For iCount = 1 To EmailCount With objFolder.Items(iCount) ReDim Preserve arrEmailDates(iCount - 1) arrEmailDates(iCount - 1) = DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) End With Next iCount ' Clear Outlook objects Set objFolder = Nothing Set objnSpace = Nothing Set objOutlook = Nothing

' Count the emails dates equal to active cell Sheets("Sheet1").Range("A1").Select Do Until IsEmpty(ActiveCell) DateCount = 0 myDate = ActiveCell.Value For i = 0 To UBound(arrEmailDates) - 1 If arrEmailDates(i) = myDate Then DateCount = DateCount + 1 Next i Selection.Offset(0, 1).Activate ActiveCell.Value = DateCount Selection.Offset(1, -1).Activate Loop End Sub