I need to produce a weekly report detailing what work I have carried out. I diligently record this in my Outlook calendar. My weekly report needs to be submitted in Microsoft Excel.
The following macro will pull the entries for the last seven days from my calendar and store it in Excel format.
Sub generateTimesheet() Dim OlApp As Outlook.Application Dim OlNameSpace As Outlook.Namespace Dim objFolder As Outlook.MAPIFolder Dim olAppointments As Object Dim olItems, olFinalItems As Outlook.Items Dim olAppointmentItem As Outlook.AppointmentItem Dim dtStart, dtEnd As Date Dim strRestriction As String dtStart = Format(Date - 7, "dd/mm/yyyy hh:mm AMPM") dtEnd = Format(Date + 1, "dd/mm/yyyy hh:mm AMPM") strRestriction = "[Start] >= '" & dtStart & "' AND [Start] <= '" & dtEnd & "'" Set OlApp = New Outlook.Application Set OlNameSpace = OlApp.GetNamespace("MAPI") Set olAppointments = OlNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar) Set olItems = olAppointments.Items olItems.IncludeRecurrences = True olItems.Sort "[Start]" Set olFinalItems = olItems.Restrict(strRestriction) Excel.ActiveWorkbook.ActiveSheet.Range("a2", Range("a2").End(xlDown).End(xlToRight)).Select Selection.Clear For Each olAppointmentItem In olFinalItems If Excel.ActiveWorkbook.ActiveSheet.Range("a2").Value = "" Then Excel.ActiveWorkbook.ActiveSheet.Range("a2").Select Else Excel.ActiveWorkbook.ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select End If ' ActiveCell.Value = Format(olAppointmentItem.Start, "dd/mm/yyyy") ActiveCell.Offset(0, 0).Value = Format(olAppointmentItem.Start, "Dddd") ActiveCell.Offset(0, 1).Value = Format(olAppointmentItem.Start, "Medium Date") ActiveCell.Offset(0, 2).Value = olAppointmentItem.Subject ActiveCell.Offset(0, 3).Value = Format(olAppointmentItem.Start, "hh:mm:ss") ActiveCell.Offset(0, 4).Value = olAppointmentItem.Duration Next Excel.ActiveWorkbook.ActiveSheet.Range("a1").Select End Sub
This macro should be placed in an excel spreadsheet and from there it will connect to Microsoft Outlook.
Stepping through the code:
- Get the dates for seven days ago and today then build a restriction clause to filter the calendar.
- Create a connection to my default calendar, sort the events by start date and apply the restriction on the dates.
- Clear the contents of the current worksheet – from A2 to the bottom right.
- Loop through each calendar entry
- Use either A2 or the first empty row below A2
- Write the relevant calendar attributes in the appropriate format on the selected row.
- End Loop
- Set the cursor to the top of the sheet.
Any problems, comments or suggestions for other macros/tips; let me know in the comments below.