Exporting Outlook Message Counts to Excel


I’m writing this post in response to a comment Shaima Alsaif left on my “Exporting Outlook Messages to Excel” entry from this last October. In the comment Shaima asked if it’s possible to alter the export to do the following:

  • Get message counts instead of messages
  • Add to the spreadsheet instead of overwriting it
  • Have the process run automatically each week

The answer to all three is “yes”. Doing this requires taking a different approach from the one I used in the original solution. The biggest change is that this solution uses VBScript instead of VBA. Here’s why. Outlook does not have a built-in means of scheduling code to run. It’s possible to get around that (e.g. using a repeating task coupled with an event handler that traps the ReminderFire event), but it’s better to use a true scheduler like the one built into Windows (i.e. Task Scheduler). To the best of my knowledge Windows Task Scheduler cannot call a VBA routine, hence the need to use VBScript instead.

Here is how the new script will meet Shaima’s requirements. Getting the message count is easy. Each Outlook folder stores its content in a collection called Items. This collection includes a Count property that denotes the number of items in the folder. As a side note, if we wanted the unread item count, then we’d look to the folder itself instead of its Items collection. Since the solution shouldn’t overwrite the Excel workbook each time we need to alter the original code to open an existing workbook instead of creating a new one each time. We also have to add code to find the last used row in the spreadsheet the message count will be written to. Once we have this we’ll add 1 to it so the new value is written to the next available line. Scheduling the script is easy. All that requires is creating a new Windows Task that calls the script and setting it to run at whatever the desired interval is.

Requirements.

  • Outlook 2007 – 2010.
  • Any version of Windows.
  • The spreadsheet(s) must already exist.
  • The computer must be on for the task scheduler to function.

Instructions.

  1. Open Notepad.
  2. Copy the code below and paste it into Notepad.
  3. Edit the code as needed. I’ve included comments where changes can/should be made.
  4. Save the file with a .vbs extension. You can name it anything you want.
  5. Create a scheduled task that runs periodically. You can set the frequency to whatever you want.
  6. Set the task to run this script.
'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 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", "C:\Message_Counts.xlsx", 1
ExportMessageCountToExcel "Personal Folders\Projects", "C:\Message_Counts.xlsx", 2

'Disconnect from Outlook
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
WScript.Quit

Sub ExportMessageCountToExcel(strFolder, strWorkbook, intSheet)
    Const EXCEL_COL = 1
    Dim olkFld, excApp, excWkb, excWks, lngRow
    Set olkFld = OpenOutlookFolder(strFolder)
    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, EXCEL_COL) = olkFld.Items.Count
    Set excWks = Nothing
    excWkb.Close True
    Set excWkb = Nothing
    excApp.Quit
    Set excApp = Nothing
    Set olkFld = 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

Notes.

Here are a few thoughts on how the code could be extended to create additional functionality.

  • Create the spreadsheet if it does not exist.
  • Get both the item and unread item counts. Right now it only reports the item count.
  • Get the counts for a folder and all its subfolders.
  • Record the date the count was recorded on.
About these ads

81 comments on “Exporting Outlook Message Counts to Excel

  1. Dear David,

    I am writing you regarding this topic, i made some modifications to the vbs script i need the script to count the e-mails only from yesterday, and it will run every single day as sheduled task.
    But there are 2 issues
    The sheet-s name is sheet2 always (although the filename is correctly set up), and for 2 folders it is counting some more see resutls in the xlsx file below.
    Scrip:http://www.mediafire.com/view/38z811zoxz94nki/NonCallBasedReport2.vbs
    Xlsx: http://www.mediafire.com/view/moa19w7lq7b9k1z/Book2.xlsx

    Could you please advise why it is not correctly showing up for the 2 folders, but all others are fine for each day.

    PS: The folder names are intentionally deleted from both the script and the xlsx

    • Hi, megoldom.

      I’m going to be unavailable for about 10 days. I’ll be back in touch with you on the 27th or 28th.

      David

    • Hi David,
      Ok solved :-) My bad. However, I’ve got another question. Can you tell me how I can have the following.
      I want to shedule a task every day at 7PM.
      So every day a new excell file should be created with all unread mails (in the specified folders) before 2:30PM

    • Hi, Pieter.

      The best way to run this on a schedule is to convert the code from VBA (code that runs from inside Outlook) to VBscript (code that runs outside of Outlook). That approach allows you to create a scheduled task in Windows Task Scheduler that would run each day at 7PM. The alternative is to add some additional code that will allow you to use an Outlook task to schedule this. For this approach to work, Outlook will have to be open and running at 7PM. Which approach do you prefer?

    • Hi David,

      I would like to use the approach with the sheduled task in windows. So maybe I can re-use some code you’ve already written.
      Can you tell me which code I have to use/adapt to have this vbs script properly working for me.
      I would be very thankfull

    • Hi, Pieter.

      I misread the post you’re comment is to. I thought you were asking about exporting messages to Excel when in fact you were asking about exporting message counts to Excel. That changes my earlier answer. The code for this pose is already written in VBScript, no modifications required. All you nee to do is download the code, edit it as needed, save to a .vbs file, then create a scheduled task that runs it on whatever schedule you want.

    • Hi David,

      But that code needs to be adapted to count the “unread” mails received before 14:30.
      The code from you main topic is not counting the unread ones. It is counting them all.
      Can you adapt the code?

      Thanks!!

    • Pieter,

      This should do it. Replace the ExportMessageCountToExcel subroutine with the one below. Leave the rest of the code as is.

      Sub ExportMessageCountToExcel(strFolder, strWorkbook, intSheet)
          Const EXCEL_COL = 1
          Dim olkFld, olkFlt, olkItm, excApp, excWkb, excWks, lngRow, lngCnt
          Set olkFld = OpenOutlookFolder(strFolder)
          Set olkFlt = olkFld.Items.Restrict("[Unread] = True")
          For Each olkItm In olkFlt
              If FormatDateTime(olkItm.ReceivedTime,vbShortTime) <= "14:30" Then
                      lngCnt = lngCnt + 1
              End If
          Next
          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, EXCEL_COL) = lngCnt
          Set excWks = Nothing
          excWkb.Close True
          Set excWkb = Nothing
          excApp.Quit
          Set excApp = Nothing
          Set olkFld = Nothing
      End Sub
      

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s