Quote:
Originally Posted by Gregg Medwid
Hi, I am hoping someone can help me with this. I would like to generate a macro that reads my Outlook Calendar events, pulls out certain data, and then copies that data into a spreadsheet.
The data I'd like to retrieve from the Calendar events is:
Category; Subject; Start_Date; Duration.
I'd like the data filtered like this: Retrieve only those Calendar events that started last month.
Thanks in advance,
Gregg.
|
This is possible, however the macro to get Excel and Outlook talking together is quite complex. To save time and effort, below are the instructions to export your calendar to Excel, then I have written a macro to clean up this data as per your requirements. (
Please note: I don't know what "Category" is, so left this out.)
To Export your Calendar from Outlook:- In Outlook, select File / Import and Export...
- Select "Export to a file" and click Next
- Select "Microsoft Excel 97-2003" and click Next
- Select your Calendar and click Next
- Give it a file location and name and click Next
- Just leave the default fields - the macro below expects them all to be there, and click Finish
- You can either filter the date range, or leave it as it is as the macro below cleans up any data not from last month
- Open up the Excel file that has just been created and copy and paste the code below into a new module (instructions can be provided for how to do this if required)
Running this macro will clean up the unwanted data (excess columns and any rows where the start date is not last month) and then create the duration in days, hours and minutes format.
Give me a shout if you have any problems or need it tweeked at all.
The Code:
Code:
Sub CleanUpCalendar()
Application.ScreenUpdating = False
' Delete unwanted columns
Columns("F:V").Select
Selection.Delete shift:=xlToLeft
Range("A2").Activate
' Add the Start and End date and time together
Do Until ActiveCell = ""
ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) & " " + ActiveCell.Offset(0, 2)
ActiveCell.Offset(0, 3) = ActiveCell.Offset(0, 3) & " " + ActiveCell.Offset(0, 4)
ActiveCell.Offset(1, 0).Activate
Loop
Range("A2").Activate
'Delete rows where the start date is not a day last month
Do Until ActiveCell = ""
If Not (Month(ActiveCell.Offset(0, 1)) = Month(Now) - 1) Then
Rows(ActiveCell.Row).Select
Selection.Delete shift:=xlUp
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("A2").Activate
' Copy & Paste values then delete times
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("C:C").Select
Selection.Delete shift:=xlToLeft
Columns("D:D").Select
Selection.Delete shift:=xlToLeft
' Create the Duration column
Range("D1").Activate
ActiveCell = "Duration"
ActiveCell.Offset(1, 0).Activate
Do Until ActiveCell.Offset(0, -1) = ""
Formula = "=C" & ActiveCell.Row & "-B" & ActiveCell.Row
ActiveCell = Formula
ActiveCell.NumberFormat = "d " & Chr(34) & "d, " & Chr(34) & "hh" & Chr(34) & ":" & Chr(34) & "mm"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, -2).NumberFormat = ("dd/mm/yy")
ActiveCell.Offset(1, 0).Activate
Loop
Range("A2").Activate
' Delete the End Date column
Columns("C:C").Select
Selection.Delete shift:=xlToLeft
Range("A1").Activate
Application.ScreenUpdating = True
End Sub