Microsoft Outlook 2016 Calendar appointment VBA Macro for Time Tracking

Microsoft Outlook 2016 Calendar appointment VBA Macro for Time Tracking

Reference: https://msdn.microsoft.com/en-us/library/office/ff866419.aspx


I wrote a Outlook VBA macro for time tracking purposes to try and account for my time. With Outlook 2016, the Journal feature which can track your time is no longer present. This was my poor man's way to provide something that I could use to track my time. There may be other methods out there, but I liked the idea of doing all of my tracking in outlook, and makes it easy to share my calendar with my boss so that he can see where all of my time is going.

I plan to augment this solution with a form, and perhaps a VB macro that will run a report and collect all of this time information.

Sub CreateAppt()
'AppointmentItem object is used

 Dim myItem As Object
 Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
 Dim TimeSpent As Integer
 Dim ProjectName As String
 Dim CategoryName As String

CategoryName = "Work"

TimeSpent = InputBox( _
"How much time did you spend on the project", _
"Time Spent on Project in minutes?", _
"30")

ProjectName = InputBox( _
"What is the name of the Project?", _
"Project Name?", _
"Ticket, Microsoft Migration")


 Set myItem = Application.CreateItem(olAppointmentItem)

 'this code turns it from appointment to a meeting
 'myItem.MeetingStatus = olMeeting

 'myItem.Subject = "Time Tracking"
 myItem.Subject = ProjectName

 myItem.Location = "WORK"

 'myItem.Start = #9/24/2009 1:30:00 PM#

 'myItem.Start = (Now() - Minute(TimeSpent))

 myItem.Start = DateAdd("n", -TimeSpent, Now())

 myItem.End = Now()
 'myItem.Duration = 1
 myItem.Duration = TimeSpent

 'Set myRequiredAttendee = myItem.Recipients.Add("Lawrence Knight")
 'myRequiredAttendee.Type = olRequired
 'Set myOptionalAttendee = myItem.Recipients.Add("Kevin Kennedy")
 'myOptionalAttendee.Type = olOptional
 'Set myResourceAttendee = myItem.Recipients.Add("Conf Rm All Stars")
 'myResourceAttendee.Type = olResource
 'myItem.ShowCategoriesDialog
  myItem.Categories = CategoryName

  'Does not display a reminder window. Not needed since I'm tracking my projects
  myItem.ReminderSet = False
  myItem.Save

 'Do not need to display the item if prompting user for input
 'myItem.Display

 'This is used for sending an invite when multiple people. Not needed for Time Tracking
  'myItem.Send

End Sub