Solved

Outlook - Quick Count of Appointments

Posted on 2008-10-22
35
537 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
 
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

If you don't know how to downgrade, my instructions below should be helpful.
Scam emails are a huge burden for many businesses. Spotting one is not always easy. Follow our tips to identify if an email you receive is a scam.
In this video we show how to create a Distribution Group 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 Recipients >>…
This video discusses moving either the default database or any database to a new volume.

747 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now