Outlook - Quick Count of Appointments

Hallo Harris!

If you would like to know the number of items present in your calendar then you could try this option:

* Open Outlook
* At the bottom of the left pane click upon "Folder List" This will be a tiny folder like icon
* Having done that, you would see your mailbox will all the items under it like, Calendar, Contacts, inbox, Deleted Items, etc
* Right click upon "Calendar" and click on "Properties" then choose the option which reads "Show total number of items"
* Click on "OK" and you will now be able to see total number of items in your mailbox which will be meeting requests.
* Please note that this count will consider all recurring appointments / meeting requests as ONE.

Hope this answers your question.

- #wyn

In Outlook 2007, there is a Count in the lower left corner, depending on the view you are in.  I have 20 for the work week, 136 for the MONTH view.  etc.

Hi, harris9999.

I can produce "a wee report" summarizing the counts with a bit of scripting.  Is that an option?

Hi,
A report option might be good.
Basically need a monthly count of appointments. And if possible split before 5pm and after 5pm.

Hi,
A report option might be good.
Basically need a monthly count of appointments. And if possible split before 5pm and after 5pm.

Ok, here's one possible solution.  The code below counts the number of appointments by month in the last year and reports the number that came before and after 5:00 PM.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on Module1
4.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
5.  Edit the code as needed.  I included comments wherever something needs to or can change
6.  Click the diskette icon on the toolbar to save the changes
7.  Close the VB Editor
8.  Click Tools > Macro > Security
9.  Set the Security Level to Medium
10.  Close Outlook
11.  Start Outlook
12.  Run the macro

Option Base 1
 
Sub AppointmentReport()
    Dim olkAppointment As Outlook.AppointmentItem, _
        olkFolder As Outlook.MAPIFolder, _
        olkItems As Outlook.Items, _
        arrCounts(12, 2) As Integer, _
        intMonth As Integer, _
        intTime As Integer, _
        objIE As Object, _
        objDoc As Object, _
        strReport As String
    Set olkFolder = Session.GetDefaultFolder(olFolderCalendar)
    Set olkItems = olkFolder.Items.Restrict("[Start] > '" & Format(DateAdd("y", -1, Date), "ddddd h:nn AMPM") & "'")
    olkItems.Sort "[Start]"
    For Each olkAppointment In olkItems
        With olkAppointment
            intMonth = Month(.Start)
            intTime = IIf(Hour(.Start) >= 17, 2, 1)
            arrCounts(intMonth, intTime) = arrCounts(intMonth, intTime) + 1
        End With
    Next
    Set olkItems = Nothing
    Set olkFolder = Nothing
    Set olkAppointment = Nothing
    strReport = "<table>"
    strReport = strReport & "<tr><td>Month</td><td>Before 5</td><td>After 5</td></tr>"
    For intMonth = 1 To 12
        strReport = strReport & "<tr><td>" & MonthName(intMonth) & "</td><td>" & arrCounts(intMonth, 1) & "</td><td>" & arrCounts(intMonth, 2) & "</td></tr>"
    Next
    strReport = strReport & "</table>"
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.navigate ("about:blank")
    Set objDoc = objIE.Document
    objDoc.Body.innerHTML = strReport
    objIE.Visible = True
End Sub

Select allOpen in new window

Is it possible to run this report for a shared calendar?
Or will I just have to log in with the account the Calendar is on?
Is it possible to include the year of the month, like it says from the last year, could it display the year beside it so say Nov will have 07 beside it, just so it is clearer.

I've made both changes.  The code will run against whatever calendar you select and the year will display next to the month.

Option Base 1
 
Sub AppointmentReport()
    Dim olkAppointment As Outlook.AppointmentItem, _
        olkFolder As Outlook.MAPIFolder, _
        olkItems As Outlook.Items, _
        arrCounts(12, 2) As Integer, _
        intMonth As Integer, _
        intTime As Integer, _
        intYear As Integer, _
        objIE As Object, _
        objDoc As HTMLDocument, _
        strReport As String
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    Set olkItems = olkFolder.Items.Restrict("[Start] > '" & Format(DateAdd("y", -1, Date), "ddddd h:nn AMPM") & "'")
    olkItems.Sort "[Start]"
    For Each olkAppointment In olkItems
        With olkAppointment
            intMonth = Month(.Start)
            intTime = IIf(Hour(.Start) >= 17, 2, 1)
            arrCounts(intMonth, intTime) = arrCounts(intMonth, intTime) + 1
        End With
    Next
    Set olkItems = Nothing
    Set olkFolder = Nothing
    Set olkAppointment = Nothing
    strReport = "<table>"
    strReport = strReport & "<tr><td width=""10%"">Month</td><td width=""10%"">Before 5</td><td width=""10%"">After 5</td></tr>"
    For intMonth = 1 To 12
        intYear = intMonth - Month(Date)
        strReport = strReport & "<tr><td>" & MonthName(intMonth) & " " & Year(IIf(intYear <= 0, Date, DateAdd("yyyy", -1, Date))) & "</td><td>" & arrCounts(intMonth, 1) & "</td><td>" & arrCounts(intMonth, 2) & "</td></tr>"
    Next
    strReport = strReport & "</table>"
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.navigate ("about:blank")
    Set objDoc = objIE.Document
    objDoc.Body.innerHTML = strReport
    objIE.Visible = True
End Sub

Select allOpen in new window

When I try to run that now I get a Compile Error: User Defined Type not defined.
Have I selected the calendar correctly
In my calendars list I have deselected my own user calendar and selected the calendar I want the report on.

Change HTMLDocument on line 12 to Object.

I get the error now:
Object Variable or With block variable not set.

What line?

It doesn't give a line.  
I think it is something to do in the lines 35 or 36.

started going through it by Stepping into it and it gave a report alright.  
But the numbers aren't right.  
June July, August etc are all 0.  
There is about 5/6 appointments in each day.  
A typical day is in the attached image.

Forgot the image.
day.gif

Let's start by clarifying how this is running.  You select a calendar folder by clicking on it.  With that folder selected you then run the script.  Right?

Are most of the appointments recurring?

The calendar an additional shared calendar opened.  Like in the attached image.
Tehn I run the Macro
Yes most appointment recurring.

calendar.gif

Ok.  I see a couple of problems.  I'll get them fixed and repost as soon as I can.

Apologies for being so slow.  Here's the revised version.  Replace the code above with the code below.

Option Base 1
 
Sub AppointmentReport()
    Dim olkAppointment As Outlook.AppointmentItem, _
        olkFolder As Outlook.MAPIFolder, _
        olkItems As Outlook.Items, _
        arrCounts(12, 2) As Integer, _
        intMonth As Integer, _
        intTime As Integer, _
        intYear As Integer, _
        objIE As Object, _
        objDoc As Object, _
        strReport As String, _
        datStart As Date, _
        datEnd As Date
    datStart = FOM(DateAdd("m", -11, Date)) & " 00:01 AM"
    datEnd = EOM(Date) & " 11:59 PM"
    Set olkFolder = Session.GetDefaultFolder(olFolderCalendar)
    Set olkItems = olkFolder.Items.Restrict("[Start] > '" & Format(datStart, "ddddd h:nn AMPM") & "' AND [Start] <= '" & Format(datEnd, "ddddd h:nn AMPM") & "'")
    olkItems.Sort "[Start]"
    olkItems.IncludeRecurrences = True
    For Each olkAppointment In olkItems
        With olkAppointment
            If Not .AllDayEvent Then
                intMonth = Month(.Start)
                intTime = IIf(Hour(.Start) >= 17, 2, 1)
                arrCounts(intMonth, intTime) = arrCounts(intMonth, intTime) + 1
            End If
        End With
    Next
    Set olkItems = Nothing
    Set olkFolder = Nothing
    Set olkAppointment = Nothing
    strReport = "<table>"
    strReport = strReport & "<tr><td width=""10%"">Month</td><td width=""10%"">Before 5</td><td width=""10%"">After 5</td></tr>"
    For intMonth = 1 To 12
        intYear = intMonth - Month(Date)
        strReport = strReport & "<tr><td>" & MonthName(intMonth) & " " & Year(IIf(intYear <= 0, Date, DateAdd("yyyy", -1, Date))) & "</td><td>" & arrCounts(intMonth, 1) & "</td><td>" & arrCounts(intMonth, 2) & "</td></tr>"
    Next
    strReport = strReport & "</table>"
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.navigate ("about:blank")
    Set objDoc = objIE.Document
    objDoc.Body.innerHTML = strReport
    objIE.Visible = True
End Sub
 
Function EOM(datInput As Date) As Date
    Dim datTemp As Date
    datTemp = DateAdd("m", 1, datInput)
    datTemp = Month(datTemp) & "/1/" & Year(datTemp)
    EOM = DateAdd("d", -1, datTemp)
End Function
 
Function FOM(datInput As Date) As Date
    FOM = Month(datInput) & "/1/" & Year(datInput)
End Function

Select allOpen in new window

When I run that I get 0 for all months.

Hmmm.  I did forget to change the code to work off any folder, so it is reading the default calendar.  To fix that, change line 18 to

Set olkFolder = Application.ActiveExplorer.CurrentFolder
 

Ok,
I now run the Macros, and it seems to take a wee while - So it must be counting all the appointments.
Then it crashes with an error in the Microsoft Visual Basic Window:
Run-time error '91':
Object Variable or With block variable not set.
It doesn't give a line number.  

Add this line above line #16.

On Error Resume Next

A Blank IE Window opens.

Yeah seems a pain in the ass alright.  Still get that error on my Laptop with XP and Office 2003 and on Windows 2003 Server with Office 2003.
I then stepped through it with the debugger having the code stop just before it starts to draw then table then step through (F8) it from there, it works fine.  
Only problem is that the actual number of appointments still isn't totally correct yet for some reason.

Ahh, so the error is coming when IE is loading.  That helps.  I think I can fix that.  Concerning the counts, I wrote the code to ignore all day events.  Might that explain why the count appears off?

No there would be no all day events.
Possibly there is appointments with overlapping times?

Example of a week in the attached image.  
calendar2.gif

Insert these three lines of code between the current lines 45 and 46.  That should cure the apparent IE issue.

        Do Until objIE.readyState = 4
            DoEvents
        Loop

Select allOpen in new window

Yep that has sorted the IE issue

Overlapping times wouldn't be a problem.  The code works by first grabbing all the appointments for the last 12 months.  Running it today should get this all appointments from November 1st, 2007 to October 31st, 2008.  The next step is to loop through those appointments.  As each appointment is checked the code looks to see if the hour in the start time is greater then or equal to 17 (i.e. 5:00 PM).  If so, then 1 is added to the After5 counter.  Otherwise, 1 is added to the Before5 counter.  Each appointment is checked individually, so another appointment at the same time isn't an issue.  The only way the code could fail to get the correct count is if the Restrict method fails to get all the items for the last 12 months or if the start time somehow fails the before/after 5 test.

Hardly any chance to do with date format?
UK Date here.

Ah might be it.  
I changed the date format in the FOM and EOM functions and got different numbers.
Going to take a manual count now.

Had a count at quite a few of them and in most it is now working so it must be something to do with the date format.  
Currently the 2 months from last year are well out.  (Nov and Dec 07)

The Code I changed:

Function EOM(datInput As Date) As Date
    Dim datTemp As Date
    datTemp = DateAdd("m", 1, datInput)
    datTemp = "1/" & Month(datTemp) & "/" & Year(datTemp)
    EOM = DateAdd("d", -1, datTemp)
End Function
 
Function FOM(datInput As Date) As Date
    FOM = "1/" & Month(datInput) & "/" & Year(datInput)
End Function

Select allOpen in new window

Sorry, I don't follow what you mean when you say, "Currently the 2 months from last year are well out."  Do you mean the counts for those months are way off or tht you don't believe they should be included in the process?  

Sorry for the delay in reply.  The counts for them months were off.  I've now been told that they need the count from January 2007.
I will ask another question about this as you have already done what was asked in my original question here.  
Thanks for your help.