If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Copying Calendar data into spreadsheet
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. |
#2
|
|||
|
|||
Quote:
To Export your Calendar from Outlook:
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 |
Thread Tools | |
Display Modes | |
|
|