View Single Post
  #2  
Old April 26th, 2011, 02:18 PM
tarquinious tarquinious is offline
Experienced Member
 
First recorded activity by OfficeFrustration: Mar 2011
Posts: 34
Default

Quote:
Originally Posted by Gregg Medwid View Post
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:
  1. In Outlook, select File / Import and Export...
  2. Select "Export to a file" and click Next
  3. Select "Microsoft Excel 97-2003" and click Next
  4. Select your Calendar and click Next
  5. Give it a file location and name and click Next
  6. Just leave the default fields - the macro below expects them all to be there, and click Finish
  7. 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
  8. 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