How to count hours/days/weeks spent on an appointment or meeting in Outlook?
Let’s say there are lots of appointments and meetings in a calendar in Outlook. And now you want to count the hours/days/weeks spent on these appointments and meetings, any idea? This article will introduce a VBA to help you.
Count hours/days/weeks spent on an appointment or meeting with VBA
Count hours/days/weeks spent on an appointment or meeting with VBA
This method will introduce a VBA to count the hours or minutes spent on the specified appointment or meeting in Outlook. Please do as follows:
1. Shift to the Calendar folder, and click to select the appointment or meeting which you will count spent hours.
2. Press Alt + F11 keys simultaneously to open the Microsoft Visual Basic for Applications window.
3. Click Insert > Module, and then paste below VBA code into the opening Module window.
VBA: Count hours/minutes spent on an appointment or meeting in Outlook
Sub CountTimeSpent() Dim oOLApp As Outlook.Application Dim oSelection As Outlook.Selection Dim oItem As Object Dim iDuration As Long Dim iTotalWork As Long Dim iMileage As Long Dim iResult As Integer Dim bShowiMileage As Boolean bShowiMileage = False iDuration = 0 iTotalWork = 0 iMileage = 0 On Error Resume Next Set oOLApp = CreateObject("Outlook.Application") Set oSelection = oOLApp.ActiveExplorer.Selection For Each oItem In oSelection If oItem.Class = olAppointment Then iDuration = iDuration + oItem.Duration iMileage = iMileage + oItem.Mileage ElseIf oItem.Class = olTask Then iDuration = iDuration + oItem.ActualWork iTotalWork = iTotalWork + oItem.TotalWork iMileage = iMileage + oItem.Mileage ElseIf oItem.Class = Outlook.olJournal Then iDuration = iDuration + oItem.Duration iMileage = iMileage + oItem.Mileage Else iResult = MsgBox("Please select some Calendar, Task or Journal items at first!", vbCritical, "Items Time Spent") Exit Sub End If Next Dim MsgBoxText As String MsgBoxText = "Total time spent: " & vbNewLine & iDuration & " minutes" If iDuration > 60 Then MsgBoxText = MsgBoxText & HoursMsg(iDuration) End If If iTotalWork > 0 Then MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total work recorded; " & vbNewLine & iTotalWork & " minutes" If iTotalWork > 60 Then MsgBoxText = MsgBoxText & HoursMsg(iTotalWork) End If End If If bShowiMileage = True Then MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total iMileage; " & iMileage End If iResult = MsgBox(MsgBoxText, vbInformation, "Items Time spent") ExitSub: Set oItem = Nothing Set oSelection = Nothing Set oOLApp = Nothing End Sub Function HoursMsg(TotalMinutes As Long) As String Dim iHours As Long Dim iMinutes As Long iHours = TotalMinutes \ 60 iMinutes = TotalMinutes Mod 60 HoursMsg = " (" & iHours & " Hours and " & iMinutes & " Minutes)" End Function
4. Press the F5 key or click the Run button to run this VBA.
And now a dialog box pops out and shows how many hours/minutes the selected appointment/meeting spent. See screenshot:
Note: You can select multiple appointments or meetings at the same time to count total hours/minutes spent on them with this VBA code.
Related Articles
Count the total number of conversations in a folder in Outlook
Count the total number of attachments in selected emails in Outlook
Count the number of recipients in To, Cc, and Bcc fields in Outlook
Kutools for Outlook - Brings 100 Advanced Features to Outlook, and Make Work Much Easier!
- Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by custom; Auto Reply without exchange server, and more automatic features...
- BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
- Reply (All) With All Attachments in the mail conversation; Reply Many Emails in seconds; Auto Add Greeting when reply; Add Date into subject...
- Attachment Tools: Manage All Attachments in All Mails, Auto Detach, Compress All, Rename All, Save All... Quick Report, Count Selected Mails...
- Powerful Junk Emails by custom; Remove Duplicate Mails and Contacts... Enable you to do smarter, faster and better in Outlook.

