'   ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----   
'   Copyright (c) 2005-2006 James P. MacLennan   All Rights Reserved
'   Questions? Comments? Suggestions? Let me know ... www.cazh1.com
   
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 2 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'   ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----   

' requires a reference to the Microsoft Outlook 8.0 Object Library

Option Explicit

Sub DailyEMailCount()
' Given a date / range, count the number of read / unread emails
' 12/20/2000 jpm - updated to count for a whole week (loop is a little long)
' 12/22/2000 jpm - start counting more outlook object types

   Dim olMAPI As Outlook.NameSpace
   Dim Folder As Outlook.MAPIFolder
   Dim oldStatusBar

   Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
   Range("rLastRun").Value = Now
   Range("rRead").Value = 0
   Range("rUnread").Value = 0
   Range("rCalendar").Value = 0

   oldStatusBar = Application.StatusBar
   Application.DisplayStatusBar = True

'   Call CountByDate("", olMAPI.Folders("Personal Folders"), "->")
   Call CountByDate("", olMAPI.Folders("Mailbox - MacLennan, James"), "->")

   Application.DisplayStatusBar = False
   Application.StatusBar = oldStatusBar

   Beep

   Set olMAPI = Nothing

End Sub

Sub CountByDate(sParentName As String, tempfolder As Outlook.MAPIFolder, a$)
' Loop thru open folder set, counting read / unread messages

   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim sWorkDate As String
   Dim dFromDate(10) As Date
   Dim dToDate(10) As Date
   Dim sCheckString As String  ' List of folder names to skip
   Dim sStatusInit As String
   Const STATUS_LEAD = "Counting Outlook transactions ("

   sCheckString = "Calendar Tasks Contacts"

   sWorkDate = CStr(Range("rDate01").Value)
   dFromDate(1) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(1) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate02").Value)
   dFromDate(2) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(2) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate03").Value)
   dFromDate(3) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(3) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate04").Value)
   dFromDate(4) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(4) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate05").Value)
   dFromDate(5) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(5) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate06").Value)
   dFromDate(6) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(6) = CDate(sWorkDate & " 11:59:59 PM")
   sWorkDate = CStr(Range("rDate07").Value)
   dFromDate(7) = CDate(sWorkDate & " 12:00:00 AM")
   dToDate(7) = CDate(sWorkDate & " 11:59:59 PM")

   sStatusInit = STATUS_LEAD & sParentName & "/" & tempfolder.Name & ") "
   Application.StatusBar = sStatusInit

   ' If this folder is in the Skip list, then geddoudahere

   If InStr(sCheckString, tempfolder.Name) = 0 Then

      ' Count the read / unread in this folder
      For j = 1 To tempfolder.Items.Count
         Application.StatusBar = Application.StatusBar & "."
         If Len(Application.StatusBar) > 100 Then
            Application.StatusBar = sStatusInit
         End If

         ' Mail Items
         If tempfolder.Items(j).Class = olMail Then
            For k = 1 To 7
               If tempfolder.Items(j).ReceivedTime <= dToDate(k) Then
                  If tempfolder.Items(j).ReceivedTime >= dFromDate(k) Then
                     Application.StatusBar = Application.StatusBar & "!"
                     If tempfolder.Items(j).UnRead Then
                        Range("rUnread")(k).Value = Range("rUnread")(k).Value + 1
                     Else
                        Range("rRead")(k).Value = Range("rRead")(k).Value + 1
                     End If
                  End If
               End If
            Next k
         End If

         ' Calendar Items

         If (tempfolder.Items(j).Class = olMeetingCancellation) Or (tempfolder.Items(j).Class = olMeetingRequest) Or (tempfolder.Items(j).Class = olMeetingResponseNegative) Or (tempfolder.Items(j).Class = olMeetingResponsePositive) Or (tempfolder.Items(j).Class = olMeetingResponseTentative) Then
            For k = 1 To 7
               If tempfolder.Items(j).ReceivedTime <= dToDate(k) Then
                  If tempfolder.Items(j).ReceivedTime >= dFromDate(k) Then
                     Application.StatusBar = Application.StatusBar & "#"
                     Range("rCalendar")(k).Value = Range("rCalendar")(k).Value + 1
                  End If
               End If
            Next k
         End If


      Next j

   End If

   ' Recurse thru all folders

   If tempfolder.Folders.Count Then
      For i = 1 To tempfolder.Folders.Count
         Call CountByDate(tempfolder.Name, tempfolder.Folders(i), a$ & "->")
      Next i
   End If

End Sub