If you are ever moving large amounts of email around it can be useful to be able to check that there is the correct number of emails in the old and new locations. This code generates a text file that can be used to compare the count of items in each folder. Just walks its way through the mailstore. includes public folders or PST files. Text file is in CSV format so it can be easily read and summarised in excel.
Sub CountAllFolders()
Dim myfolder, mymyfolder, mydestfolder, mydestfolder1 As Folder
Dim myisempty As Boolean
mymsg = ""
errorlist = ""
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
For x = 1 To myNameSpace.Folders.Count
Set myfolder = myNameSpace.Folders(x)
mymsg = mymsg + countthisfolder(myfolder)
Next x
'MsgBox mymsg
'should be putting this somewhere cleverer
FilePath = "c:\windows\temp\outlookfolderitemscount.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(FilePath, 2, True)
objFile.Write (mymsg)
Set objFile = Nothing
Set objFSO = Nothing
'Stop
'myfolder.Display
End Sub
Function countthisfolder(ByVal myfolders As Folder)
mymsg = ""
mymsg = """" + myfolders.FolderPath + """," + CStr(myfolders.Items.Count) + vbCrLf
For i = 1 To myfolders.Folders.Count
mymsg = mymsg + countthisfolder(myfolders.Folders(i)) + vbCrLf
Debug.Print myfolders.Folders(i).FolderPath
Next i
countthisfolder = mymsg
End Function
