Cut (or copy) and paste is not working at this time. The appointments need to be added to the calendar as new items, otherwise they will not sync up to the server. The macro works with individual appointments and recurring appointments but DOES NOT support Exceptions.
Although you can’t drag and drop appointments into a Group Calendar, or import a calendar ics file (or CSV) directly into a group calendar, you can add events to a group calendar in bulk using a macro.
If the appointments are in a .ics file, you'll need to import the events into an Outlook Calendar (or open the ics file as a Calendar). Do not import them into your own calendar as the macro creates a copy of everything in the source calendar into the Group Calendar and sends invites to all group members.
The second macro below created appointments using data stored in CSV files or Excel Wordbooks.
Use a Macro to Copy Appointments
This macro will copy appointments from a calendar in your mailbox (this example uses a subfolder under your calendar folder called "CopyGroups") to the group calendar and sends the meeting (which is required to add it to the group calendar and sync to the server.)
This macro does not copy exceptions (it will handle recurrences).
To use, add the appointments you need on the group calendar to a calendar folder in your mailbox then select the group calendar you want to add them to and run the macro.
Option Explicit Public Sub CopytoGroupCalendar() Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.Folder Dim objGroupFolder As Outlook.Folder Dim obj As Object Dim cAppt As AppointmentItem Dim moveAppt As AppointmentItem Dim strName As String Set objOL = Outlook.Application ' Calendar containing the appointments Set objFolder = Session.GetDefaultFolder(olFolderCalendar).folders("CopyGroups") Set objItems = objFolder.Items 'you are viewing the group calendar to add them to Set objGroupFolder = objOL.ActiveExplorer.CurrentFolder strName = objGroupFolder.name For Each obj In objItems Set cAppt = objGroupFolder.Items.Add(olAppointmentItem) With cAppt .Subject = obj.Subject & Format(Time, " hh:mm:ss") .Start = obj.Start .Duration = obj.Duration .Location = obj.Location .Body = obj.Body .Categories = obj.Categories .Save .Send End With If obj.IsRecurring = True Then Dim objPattern As RecurrencePattern Dim cApptPattern As RecurrencePattern Set objPattern = obj.GetRecurrencePattern Set cApptPattern = cAppt.GetRecurrencePattern cApptPattern.StartTime = objPattern.StartTime cApptPattern.EndTime = objPattern.EndTime cApptPattern.RecurrenceType = objPattern.RecurrenceType cApptPattern.PatternStartDate = objPattern.PatternStartDate cApptPattern.Interval = objPattern.Interval cApptPattern.NoEndDate = objPattern.NoEndDate cApptPattern.Duration = objPattern.Duration cApptPattern.Occurrences = cApptPattern.Occurrences If objPattern.NoEndDate = False Then cApptPattern.PatternEndDate = objPattern.PatternEndDate End If If objPattern.RecurrenceType = olRecursWeekly Then cApptPattern.DayOfWeekMask = objPattern.DayOfWeekMask End If If objPattern.RecurrenceType = olRecursMonthly Then cApptPattern.DayOfMonth = cApptPattern.DayOfMonth End If If objPattern.RecurrenceType = olRecursMonthNth Then cApptPattern.DayOfWeekMask = cApptPattern.DayOfWeekMask End If If objPattern.RecurrenceType = olRecursYearly Then cApptPattern.DayOfMonth = cApptPattern.DayOfMonth End If If objPattern.RecurrenceType = olRecursYearNth Then cApptPattern.DayOfWeekMask = cApptPattern.DayOfWeekMask End If End If cAppt.Save Next Set obj = Nothing Set objItems = Nothing Set objFolder = Nothing Set objOL = Nothing End Sub
Import From Excel
If the appointment data is stored in a CSV or Excel workbook, you can import the worksheet using this Outlook macro.
To use, open the Group Calendar you want to add the appointments to and run the macro.
The Excel version of this macro is here: "Create Appointments Using Spreadsheet Data". You'll need to identify the Group Folder using Set CalFolder = olApp.ActiveExplorer.CurrentFolder and select the Group Calendar before running the macro.
Public Sub ImportExcelToGroup() Dim olApp As Outlook.Application Dim olAppt As Outlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As Outlook.NameSpace Dim CalFolder As Outlook.Folder Dim i As Long Dim xlApp As Object Dim xlWB As Object Dim xlSheet As Object Dim enviro As String Dim strPath As String On Error GoTo Err_Execute enviro = CStr(Environ("USERPROFILE")) 'the path of the workbook strPath = enviro & "\Documents\appointments.xlsx" On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err <> 0 Then Application.StatusBar = "Please wait while Excel source is opened ... " Set xlApp = CreateObject("Excel.Application") blnCreated = True End If On Error GoTo 0 'Open the workbook to input the data Set xlWB = xlApp.Workbooks.Open(strPath) Set xlSheet = xlWB.Sheets("Sheet1") On Error Resume Next Set olApp = Outlook.Application On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olApp.ActiveExplorer.CurrentFolder i = 2 Do Until Trim(xlSheet.Cells(i, 1).Value) = "" Set olAppt = CalFolder.Items.Add(olAppointmentItem) With olAppt 'Define calendar item properties .Start = xlSheet.Cells(i, 5) + xlSheet.Cells(i, 6) '+ TimeValue("9:00:00") .End = xlSheet.Cells(i, 7) + xlSheet.Cells(i, 8) '+TimeValue("10:00:00") .Subject = xlSheet.Cells(i, 1) .Location = xlSheet.Cells(i, 2) .Body = xlSheet.Cells(i, 3) .BusyStatus = olBusy .ReminderMinutesBeforeStart = xlSheet.Cells(i, 9) .ReminderSet = True .Categories = xlSheet.Cells(i, 4) .Save End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Set xlWB = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
Delete Meetings from Group Calendar
One thing I quickly discovered when testing the macro was how tedious it is to delete events from a group calendar. Because each event is a meeting, you can't simply delete everything, you need to cancel the meetings and send the Cancelation. This macro clears the Group Calendar but does not send cancelation messages - if you need to send cancelations, you'll need to cancel each meeting "the old fashioned way".
To use, select the Group calendar you need to clear then run the macro.
Public Sub DeleteGroupMeetinga() Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.MAPIFolder Dim obj As AppointmentItem Dim intCount As Long Set objOL = Outlook.Application Set objFolder = objOL.ActiveExplorer.CurrentFolder Set objItems = objFolder.Items For intCount = objItems.Count To 1 Step -1 Set obj = objItems.Item(intCount) With obj .MeetingStatus = olMeetingReceivedAndCanceled .Delete End With Next Set obj = Nothing Set objItems = Nothing Set objFolder = Nothing Set objOL = Nothing End Sub
Copy and Paste (not currently working)
You need to use Cut and Paste, drag and drop doesn’t work.
- Import the ics into your calendar.
- Switch to the List view.
- Select the events then use Ctrl+X to cut (or Ctrl+C to copy).
- Switch to a List view on the group calendar.
- Use Ctrl+V to paste.
- Reset the view or switch back to the monthly view when you're finished.
If you are only moving recently imported events into the group calendar, add the modified field to the view. Turn off grouping and sort by the Modified date field. Cut or copy the appointments based on the modified time.
How to Use Macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 and above, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
I know this an old thread but hoping someone can assist. I've used macro before and it work but all of the appointments came over with what I think is the time of import in the subject line ex. Columbus Day 14:15:10
Is there any way to remove the numbers?
Sure... edit the macro to remove the time;
.Subject = obj.Subject & Format(Time, " hh:mm:ss")
.Subject = obj.Subject
Thank you! So I edited it to remove he time but now I'm getting run-time error that says I must specify a valid time. When I click Debug it goes to this line:
cApptPattern.StartTime = objPattern.StartTime
Is there something else I need to do?
The only thing you needed to do to remove the time from the subject was edit the subject line. That would not affect recurring events.
That's what I did (see below in bold) and when I ran it I received the attached error message. I also noticed that about 20 appointments did copy but that is a small fraction of what should have copied. I didn't make any other changes outside of what you instructed. Option Explicit Public Sub CopytoGroupCalendar() Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.Folder Dim objGroupFolder As Outlook.Folder Dim obj As Object Dim cAppt As AppointmentItem Dim moveAppt As AppointmentItem Dim strName As String Set objOL = Outlook.Application ' Calendar containing the appointments Set objFolder = Session.GetDefaultFolder(olFolderCalendar).Folders("United States Holidays") Set objItems = objFolder.Items 'you are viewing the group calendar to add them to Set objGroupFolder = objOL.ActiveExplorer.CurrentFolder strName = objGroupFolder.Name For Each obj In objItems Set cAppt = objGroupFolder.Items.Add(olAppointmentItem) With cAppt .Subject = obj.Subject .Start = obj.Start .Duration = obj.Duration .Location = obj.Location .Body = obj.Body .Categories = obj.Categories .Save .Send End With If obj.IsRecurring = True Then Dim objPattern As RecurrencePattern Dim cApptPattern As RecurrencePattern Set objPattern = obj.GetRecurrencePattern Set cApptPattern = cAppt.GetRecurrencePattern cApptPattern.StartTime = objPattern.StartTime cApptPattern.EndTime = objPattern.EndTime cApptPattern.RecurrenceType = objPattern.RecurrenceType cApptPattern.PatternStartDate = objPattern.PatternStartDate cApptPattern.Interval = objPattern.Interval cApptPattern.NoEndDate = objPattern.NoEndDate… Read more »
Thanks so much Diane! your instructions were great. Only had trouble , the COPYGROUPS must be in the CALENDARS folder. My bad. Thanks,
I know that this entry is quite old but still I hope, that someone can help me with an issue I got. After a long way to add an appointment to a group calendar by using a macro, this finally helped me! Thanks for that. The only thing I would like to do is to add attendees with this code. Right now, the appointment is being created with ALL people that got access to the group calendar but I got several appointments that shall be added with individual attendees for each position.
Is there a chance to do that? Unfortunately I am very noobish when it comes to VBA so I hope I can get some advice from you.
Thanks in advance,
I'll take a look at it - see if it works. It will need ot be converted to a meeting (easy) and the recipients added - just not sure who well groups will like it.
How were you able to get it to run? Ever time I attempt, I get the pop up "the macros in this project are disabled."
Would appreciate if you have any advice as this is the only method of importing to a group calendar that I've found to have any potential..Thanks
Thanks for this, very useful macro.
There seems to be an error with annually recurring appointments, they come in with a day of the week recurrence (yay its my birthday every week) I see the code does the same thing for annual as day of the week recurrences so suspect its just a mistake. I also had a problem with some non-recurring appointments still going into the recurrence analysis and giving a date error because they have a date of 0 (year 1600). Adding a check for 0 dates and skipping those appointments seem to fix it, but I don't know why they were being looked at anyway.
Is copy and paste working now? I was able to do it with the latest build.
It's probably been fixed for about a year- if its working, no one would be looking for how to do it so i put off updating the page. :)
Copy and paste into the calendar works (always has) - its the sync to the server that doesn't work.
Actually, the problem wasn't with copy and paste (it appears to work) but with syncing the things you copied and pasted... you need to confirm they sync up to the server, either by checking the calendar from another account that has access, checking from OWA, or deleting the NST file (close outlook, delete it, reopen outlook).
It looks like it wasn't fixed... things aren't syncing up.
Gave the Macro to Copy Appointments a try. I encountered the following error"visual basic runtime error '-315490295 (ed320009)': you must specifiy a valid time" at the line cApptPattern.StartTime = objPattern.StartTime under the recurrence section. The result was some of the appointment copied to my Office 365 Group Calendar, but only three recurrences worked. The rest of the appointments with recurrences only copied over the first appointment with no recurrence pattern. It also put the time that I ran the macro into the Subject line of every appointment that it copied. Any suggestions on how resolve the recurrence issue?
Sorry I missed this earlier. :( The import time is added in this line:
.Subject = obj.Subject & Format(Time, " hh:mm:ss")
you can remove the time code.
i will need to test it to see if i can repro the error - but that error indicates the value for the start field is not correct.
Running into the same error. Any wisdom?
It means the time is not properly formatted. Is it erroring on the same line?
cApptPattern.StartTime = objPattern.StartTime
I am having this error at the same line
I too am having this very issue, and that is where I am seeing my error as well. I only have a single recurring appointment show up on my test group calendar.
Diane, I am having this same issue with only one of my recurring appointments being copied. Any chance you were able to figure out the issue?
Thank you for this! Save me a ton of time.
I also need this to work. However, I have about 5k events that I want to copy over to Outlook Groups so editing each one would prove rather time consuming.
Are there other items on the calendar? It might be possible to use a macro to copy (and then delete) the original so they upload. (It would definitely be better if they fixed this on the backend.)
Mostly just one time appointments, meetings. Maybe about 30 recurring. Wondering if there's a PowerShell way to automate it.
There is a ps script to import appointments from a spreadsheet and should be one3 to import from a pst, but i don't know if they will work with groups. The reason they aren't syncing up is because they need to be meetings, not appointments, and Sent.
I have a macro that works, but currently only works with individual events, not recurring. I'll post it on this page next then work on recurring. Just copying in-place, settings as a meeting and sending isn't working - was hoping it would as it would be easy. Using a macro to create new appointments (as meetings, and send them) in the folder works.