Count Email Dates

Count Email Dates

December 28, 2018

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
 

Please reload

Contact Me With Your Litigation Support Questions:

seankevinoshea@hotmail.com

  • Twitter Long Shadow

© 2015 by Sean O'Shea . Proudly created with Wix.com