Solved

Outlook - Quick Count of Appointments

Posted on 2008-10-22
35
544 Views
Last Modified: 2011-10-19
In Outlook which is running from Exchange is there a quick way of counting the number of appointments?
Or some way to create a wee report which displays the number of appointments in each day/month?
Rsther than having to go create them manually.  
0
Comment
Question by:harris9999
  • 18
  • 15
  • +1
35 Comments
 
LVL 13

Expert Comment

by:ashwynr
ID: 22778066
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
0
 
LVL 15

Expert Comment

by:WilyGuy
ID: 22778249
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22778265
Hi, harris9999.

I can produce "a wee report" summarizing the counts with a bit of scripting.  Is that an option?
0
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 
LVL 3

Author Comment

by:harris9999
ID: 22778490
Hi,
A report option might be good.
Basically need a monthly count of appointments. And if possible split before 5pm and after 5pm.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22778506
Hi,
A report option might be good.
Basically need a monthly count of appointments. And if possible split before 5pm and after 5pm.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22782604
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

Open in new window

0
 
LVL 3

Author Comment

by:harris9999
ID: 22790918
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22791441
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

Open in new window

0
 
LVL 3

Author Comment

by:harris9999
ID: 22791664
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22791798
Change HTMLDocument on line 12 to Object.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22791824
I get the error now:
Object Variable or With block variable not set.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22791843
What line?
0
 
LVL 3

Author Comment

by:harris9999
ID: 22791912
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.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22791915
Forgot the image.
day.gif
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22791977
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?
0
 
LVL 3

Author Comment

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

calendar.gif
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22792384
Ok.  I see a couple of problems.  I'll get them fixed and repost as soon as I can.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22820194
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

Open in new window

0
 
LVL 3

Author Comment

by:harris9999
ID: 22825861
When I run that I get 0 for all months.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22826989
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
 
0
 
LVL 3

Author Comment

by:harris9999
ID: 22827166
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.  
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22827396
Add this line above line #16.

On Error Resume Next
0
 
LVL 3

Author Comment

by:harris9999
ID: 22827408
A Blank IE Window opens.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 22827686
I hate these kinds of problems.  I run the code here and it always works.  I've run against multiple calendars and on two different systems, one XP/Office 2003 and the other Vista/Office 2007.  It never fails except for the one time I mistakenly selected a contact folder instead of a calendar.  

I added a couple of edits to the code.  Replace the AppointmentReport module with this version and please try again.
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
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    If olkFolder.DefaultItemType <> olAppointmentItem Then
        MsgBox "The current folder isn't a calendar.  Processing aborted.", vbCritical + vbOKOnly, "Appointment Report"
    Else
        datStart = FOM(DateAdd("m", -11, Date)) & " 00:01 AM"
        datEnd = EOM(Date) & " 11:59 PM"
        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
            If TypeName(olkAppointment) <> "Nothing" Then
                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
            End If
            Set olkAppointment = Nothing
        Next
        Set olkItems = Nothing
        Set olkFolder = 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 If
    Set objIE = Nothing
    Set objDoc = Nothing
End Sub

Open in new window

0
 
LVL 3

Author Comment

by:harris9999
ID: 22827799
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.

0
 
LVL 76

Expert Comment

by:David Lee
ID: 22827837
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?
0
 
LVL 3

Author Comment

by:harris9999
ID: 22827867
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
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22827876
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

Open in new window

0
 
LVL 3

Author Comment

by:harris9999
ID: 22827908
Yep that has sorted the IE issue
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22827937
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.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22827983
Hardly any chance to do with date format?
UK Date here.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22828005
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.
0
 
LVL 3

Author Comment

by:harris9999
ID: 22828073
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

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
ID: 22857469
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?  
0
 
LVL 3

Author Comment

by:harris9999
ID: 22867489
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.  
0

Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you don't know how to downgrade, my instructions below should be helpful.
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
In this video we show how to create an Accepted Domain in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Ac…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question