' frmCountMail: Count items in your Mail folders, and display the folders that have > some max
'               Tool for use when managing your mail

' 07/04/2002 jpm : Original version - see imbedded comments
' 10/13/2004 - for cazh1.com - here is a form that this goes with - if you're interested, drop me an email
'                              (see cazh1.com home page)

'   ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----   
'   Copyright (c) 2002 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.
'   ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----   

Option Explicit

Const cItemMax = 20   ' default value

Private Sub UserForm_Activate()
' Load the various control / attach fields with the stashed defaults

   txtMaxItems.Value = GetSetting(cAppNameOutlook, "Main", "MaxItems", cItemMax)

' and automatically refresh the list box
   cmdGo_Click
End Sub

Private Sub UserForm_Terminate()
' Save the various control / attach fields with the latest user input

   SaveSetting cAppNameOutlook, "Main", "MaxItems", txtMaxItems.Value

End Sub

Private Sub cmdDone_Click()
   Unload frmCountMail
End Sub

Private Sub cmdGo_Click()
' Scan all Mail Item folders in my default account, and list the ones that
' have greater than "cItemMax" items (defined in the subroutine)

   Dim myOlApp As Object             ' Pointer for Outlook app object
   Dim myNameSpace As Object         ' Pointer for Outlook name space
   Dim myDefBox As Object            ' Pointer for finding the default account
   Dim myParent As Object            ' Pointer for parent folder for things to be counted

' Empty out the list of folders / counts in the combo box
   frmCountMail!lstFolders.Clear

' "Navigating" to find our favorite folder
   Set myOlApp = CreateObject("Outlook.Application")
   Set myNameSpace = myOlApp.GetNamespace("MAPI")
   Set myDefBox = myNameSpace.GetDefaultFolder(olFolderInbox) ' Look for the default inbox
   Set myParent = myDefBox.Parent                             ' Inbox parent is where I want to start

' Loop through the folders
   Call CountMailItems("", myParent, "->")

' None? At least let me know I'm done counting ...
   If frmCountMail!lstFolders.ListCount = 0 Then
      frmCountMail!lstFolders.AddItem "  -- > None < --"
   End If

' Release your Outlook objects
   Set myParent = Nothing
   Set myDefBox = Nothing
   Set myNameSpace = Nothing
   Set myOlApp = Nothing

End Sub

Sub CountMailItems(sParentName As String, tempfolder As Outlook.MAPIFolder, a$)
' Loop thru open folder set, counting mail items only
' If it contains > cItemMax, we add to the list box on this form

   Dim i As Integer

   ' There are some folders we do not deal with
   If tempfolder.Name = "Deleted Items" Then Exit Sub
   If tempfolder.Name = "Sent Items" Then Exit Sub
   If tempfolder.Name = "Inbox" Then Exit Sub
   If tempfolder.DefaultItemType <> olMailItem Then Exit Sub

   ' Debug.Print tempfolder.Name, tempfolder.Items.Count
   If tempfolder.Items.Count >= txtMaxItems.Value Then
      frmCountMail!lstFolders.AddItem tempfolder.Name
      frmCountMail!lstFolders.List((frmCountMail!lstFolders.ListCount - 1), 1) = tempfolder.Items.Count
   End If

   ' Recurse thru all subfolders
   If tempfolder.Folders.Count Then
      For i = 1 To tempfolder.Folders.Count
         Call CountMailItems(tempfolder.Name, tempfolder.Folders(i), a$ & "->")
      Next i
   End If

End Sub