Use this Excel macro to create appointments in different subcalendars in Outlook. To use, type the appointment data in the rows and then run the macro. The macro processes all rows that contain data in Column A, creating appointments using the data in the other columns.
To use, create a spreadsheet with the fields in this order: Calendar Name, Subject, Location, Body, Category, Start, Start Time, End, End Time, Reminder. Set Excel's VBA security to low, then paste the macro into Excel's VBA editor and run the macro.
The calendar's listed in Column A need to exist, Outlook won't create them.
This is an Excel macro. You'll also need to set a reference to the Outlook object model in Excel's VBA Editor's Tools, References dialog.
A version of the macro that skips previously imported events is here. A sample workbook is here.
Tip: If all appointments start and/or end at the same time, you can set a specific time value instead of getting it from the spreadsheet:
.Start = Cells(i, 5) + TimeValue("9:00:00") .End = Cells(i, 7) + TimeValue("10:00:00")
Option Explicit Public Sub CreateOutlookApptz() Sheets("Sheet1").Select On Error GoTo Err_Execute Dim olApp As Outlook.Application Dim olAppt As Outlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As Outlook.Namespace Dim CalFolder As Outlook.MAPIFolder Dim subFolder As Outlook.MAPIFolder Dim arrCal As String Dim i As Long On Error Resume Next Set olApp = Outlook.Application If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = 2 Do Until Trim(Cells(i, 1).Value) = "" arrCal = Cells(i, 1).Value Set subFolder = CalFolder.Folders(arrCal) Set olAppt = subFolder.Items.Add(olAppointmentItem) 'MsgBox subFolder, vbOKCancel, "Folder Name" With olAppt 'Define calendar item properties .Start = Cells(i, 6) + Cells(i, 7) .End = Cells(i, 8) + Cells(i, 9) .Subject = Cells(i, 2) .Location = Cells(i, 3) .Body = Cells(i, 4) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 10) .ReminderSet = True .Categories = Cells(i, 5) .Save End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
Create Appointments in One Calendar
This version of the macro creates all of the appointments in one calendar. (This sample uses the default calendar.)
To use, create a spreadsheet with the fields in this order: Subject, Location, Body, Category, Start, Start Time, End, End Time, Reminder. Set Excel's VBA security to low, then paste the macro into Excel's VBA editor and run the macro.
Option Explicit Public Sub CreateOutlookAppointments() Sheets("Sheet1").Select On Error GoTo Err_Execute Dim olApp As Outlook.Application Dim olAppt As Outlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As Outlook.NameSpace Dim CalFolder As Outlook.MAPIFolder Dim i As Long On Error Resume Next Set olApp = Outlook.Application If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = 2 Do Until Trim(Cells(i, 1).Value) = "" Set olAppt = CalFolder.Items.Add(olAppointmentItem) With olAppt 'Define calendar item properties .Start = Cells(i, 5) + Cells(i, 6) .End = Cells(i, 7) + Cells(i, 8) .Subject = Cells(i, 1) .Location = Cells(i, 2) .Body = Cells(i, 3) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 9) .ReminderSet = True .Categories = Cells(i, 4) .Save ' For meetings or Group Calendars ' .Send End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
Add or Delete Appointments from the Calendar
This version of the Excel macro will add or delete appointments in a spreadsheet. For example, it will solve this user's problem: Delete Outlook Appts with Excel sheet
Please note: this macro has the fields in a different order than the other macros on this page.
This is an Excel macro.
The appointments created with this macro will use the default reminder times configured in your Outlook at the time of the import.
This macro is also available in this text file.
Option Explicit Public Sub CreateDeleteAppointments() ActiveSheet.Select On Error GoTo Err_Execute Dim olNs As Object 'Outlook.Namespace Dim olApp As Object 'Outlook.Application Dim olAppt As Object 'Outlook.AppointmentItem Dim blnCreated As Boolean Dim CalFolder As Object 'Outlook.MAPIFolder Dim CalItems As Object 'Outlook.Items Dim ResItems As Object 'Outlook.Items Dim sFilter, strSubject As String Dim itm As Object Dim dtStart, dtEnd As Date Dim i As Long On Error Resume Next Set olApp = GetObject(, "Outlook.Application") If Err.Number <> 0 Then Set olApp = CreateObject("Outlook.Application") blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(9) Set CalItems = CalFolder.Items CalItems.Sort "[Start]" i = 2 Do Until Trim(Cells(i, 1).Value) = "" If Cells(i, 7).Value = "Delete" Then ' create search string to find events to delete strSubject = Cells(i, 5) dtStart = Cells(i, 1) + Cells(i, 3) dtEnd = Cells(i, 2) + Cells(i, 4) 'create the Restrict filter by day and recurrence" sFilter = "[Start] = '" & dtStart & "' And [End] = '" & dtEnd & "' And [Subject] = """ & strSubject & """" 'Debug.Print sFilter Set ResItems = CalItems.Restrict(sFilter) 'Debug.Print ResItems.Count 'Loop through the items in the collection. For Each itm In ResItems itm.Delete Next Else Set olAppt = CalFolder.Items.Add(1) With olAppt 'Define calendar item properties .Start = Cells(i, 1) + Cells(i, 3) .End = Cells(i, 2) + Cells(i, 4) .Subject = Cells(i, 5) '.Location = Cells(i, 2) ' .Body = Cells(i, 3) If Cells(i, 7).Value = "x" Then .AllDayEvent = True End If .BusyStatus = 2 'olBusy ' .ReminderMinutesBeforeStart = Cells(i, 9) '.ReminderSet = True .Categories = Cells(i, 9) .Save ' For meetings or Group Calendars ' .Send End With End If i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
Create Appointments in Different Time Zones
You can create the appointments in different time zones. This sample creates appointments in the default calendar from Excel data. The time zones are hardcoded. If you need to use different time zones for each appointment, add the time zone names to the spreadsheet and add the time zones like this:
Dim timezonestart As Variant, timezoneend As Variant i = 2 Do Until Trim(Cells(i, 1).Value) = "" timezonestart = Cells(i, 12) timezoneend = Cells(i, 13) Set tzStart = olApp.TimeZones.Item(timezonestart) Set tzEnd = olApp.TimeZones.Item(timezoneend)
Option Explicit Public Sub CreateOutlookApptTZ() Sheets("Sheet1").Select ' On Error GoTo Err_Execute Dim olApp As Outlook.Application Dim olAppt As Outlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As Outlook.Namespace Dim CalFolder As Outlook.MAPIFolder Dim arrCal As String Dim tzStart As TimeZone, tzEnd As TimeZone Dim i As Long On Error Resume Next Set olApp = Outlook.Application Set tzStart = olApp.TimeZones.Item("Eastern Standard Time") Set tzEnd = olApp.TimeZones.Item("UTC") If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = 2 Do Until Trim(Cells(i, 1).Value) = "" Set olAppt = CalFolder.Items.Add(olAppointmentItem) With olAppt 'Define calendar item properties .StartTimeZone = tzStart .Start = Cells(i, 6) + Cells(i, 7) .EndTimeZone = tzEnd .End = Cells(i, 8) + Cells(i, 9) .Subject = Cells(i, 2) .Location = Cells(i, 3) .Body = Cells(i, 4) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 10) .ReminderSet = True .Categories = Cells(i, 5) .Save End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
Create Appointment from Selected Row
This Excel macro is used to create an appointment using the data in the selected row. To use, select a cell in the row you wish to use then run the macro.
Option Explicit Public Sub CreateOneAppointment() 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 On Error Resume Next Set olApp = Outlook.Application If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = ActiveCell.Row Set olAppt = CalFolder.Items.Add(olAppointmentItem) With olAppt 'Define calendar item properties .Start = Cells(i, 5) + Cells(i, 6) .End = Cells(i, 7) + Cells(i, 8) .Subject = Cells(i, 1) .Location = Cells(i, 2) .Body = Cells(i, 3) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 9) .ReminderSet = True .Categories = Cells(i, 4) .Save End With Set olAppt = Nothing Set olApp = Nothing End Sub
Send Meeting Requests
Use this macro to send meeting requests. Do not use a location if you are adding a resource.
As written for the macro below, the fields in the CSV are, left to right:
Subject
Location
Body
Categories
Start Date
Start Time
End Date
End Time
Minutes before Start
Required (limited to one person or group)
Optional (limited to one person or group)
Resource (limited to one person or group)
If your CSV has the fields in a different order, change the column number in in the appointment code, for example: .Body = Cells(i, 3).
If you need to send it to multiple addresses, you'll need to use the split function then loop the attendee code to add each address separately.
Option Explicit Public Sub CreateOutlookAppointments() Sheets("Sheet1").Select On Error GoTo Err_Execute Dim olApp As Outlook.Application Dim olAppt As Outlook.AppointmentItem Dim blnCreated As Boolean Dim olNs As Outlook.Namespace Dim CalFolder As Outlook.MAPIFolder Dim i As Long On Error Resume Next Set olApp = Outlook.Application If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 Set olNs = olApp.GetNamespace("MAPI") Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) i = 2 Do Until Trim(Cells(i, 1).Value) = "" Set olAppt = CalFolder.Items.Add(olAppointmentItem) With olAppt .MeetingStatus = olMeeting 'Define calendar item properties .Subject = Cells(i, 1) ' don't use a location if using a resource ' .Location = Cells(i, 2) .Body = Cells(i, 3) .Categories = Cells(i, 4) .Start = Cells(i, 5) + Cells(i, 6) .End = Cells(i, 7) + Cells(i, 8) .BusyStatus = olBusy .ReminderMinutesBeforeStart = Cells(i, 9) .ReminderSet = True ' get the recipients Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient Set RequiredAttendee = .Recipients.Add(Cells(i, 10).Value) RequiredAttendee.Type = olRequired Set OptionalAttendee = .Recipients.Add(Cells(i, 11).Value) OptionalAttendee.Type = olOptional Set ResourceAttendee = .Recipients.Add(Cells(i, 12).Value) ResourceAttendee.Type = olResource ' For meetings or Group Calendars ' use .Display instead of .Send when testing or if you want to review before sending .Send End With i = i + 1 Loop Set olAppt = Nothing Set olApp = Nothing Exit Sub Err_Execute: MsgBox "An error occurred - Exporting items to Calendar." End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Excel 2010 or newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings.
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.
Paste the macro in Excel and run.
My attempt is getting hung up on the define calendar item properties. .Start = Cells(i, 1) + Cells(i, 3) "Run-time error '440': Automation error
After enabling the outlook library, it changed the error to Run-time error 9 subscript out of range. Any recommendations?
Good Day,
Thanks for the code. The Delete Appointments from the Calendar code does not remove the previous appointment from the calendar as expected. It only avoids adding duplication to the calendar.
Do perhaps have an update code to solve this?
Is it also possible to avoid adding duplicate reminders in the calendar and to ignore lines with no dates, but still look through all the lines in the table?
Thanks!
Hi Dianne,
Fantastic macros, thank you so much!
I'm trying to adapt/combine two of these macros to create one that checks whether appointments have been scheduled, schedules new appointments and sends a meeting request to required attendees.
I've used the code you created here (https://www.slipstick.com/macros/excel-save-calendar-macro.txt) as a base, then attempted to add the relevant code from your 'Send Meeting Requests' code and adjust the macro accordingly (I disabled the optional attendees and resource attendees as I'm not using them and it was creating an error message for me).
When I run the code, it doesn't prompt any error, it runs through the rows on the sheet and marks them as imported. BUT, no meeting requests are sent out. I've attached my testing spreadsheet for reference.
I can't figure out why it seems to run successfully, but creates no appointments/meeting requests. Any help would be great! Thank you!
Sorry, just realised the code was not presenting well in my original comment, so I have also included it in a text file attached to this comment.
Hi Diane,
Thanks for the meeting request code, it works a treat, i'm really no good at VBA and would very much like the code to change what it does when it encounters and specific email address. I am trying to setup a ROTA and i have the code searching for dates in an excel list via HLOOKUP and returning the email address of people it finds at that date and sends out meeting requests to each individual to remind them
However not everyone puts their name down on the rota and i've managed to use some Excel codes to paste a team email address into a cell when it finds a blank date.
However my code then emails the team email address inviting everyone on the list. i have two questions which i hope you can help with:
1) how can i exclude the team email address from being part of the code so it ignores it and moves on?
2) How can i setup the code to instead send an email out to the team email address basically saying there is currently noone down for ROTA?
Thanks
James
I've managed to get the "Create Appointments in One Calendar" to work as i need it. The only extra thing i need it to do is if it finds a blank cell in the 'start' and 'end' columns.
Basically, I have a formula in those boxes where it displays a date if another cell has been populated but will display "" (blank) if the other cell hasn't been populated.
How can I get this to work where it will ignore any cells with no dates in them? When the cells are blank, the macro just errors.
For example, in the screen shot, If cell E10 is empty because the formula has not found a date in the other sheet, how can I make it so this will ignore the empty cell and generate the appointments for the dates that are populated?
Many thanks,
Hi Diane:
The code seems really helpful. I am probably the least experienced in this. I'll explain what I need and if you could then direct me for the right code.
I have 2 mailboxes set in outlook. I am trying to use one to create multiple meeting requests on a daily basis.
I tried the meeting request code but I received an error saying Compile error: User-defined type not defined and it highlights Dim olApp As Outlook.Application.
Just a note, should I be having a calendar name on the excel file? Additionally, it needs to be saved as a CSV file right?
Looking forward to your assistance.
Thanks
Adeeb
Hi Daine,
Your code is working well. Thank you very much.
I got a problem while I coding more 5 macros in order to send 5 invitations at the same time. I'm using call function and its time for some macro is reference cell is incorrect. For example, in my worksheet, I put 11:00 for start time and 12:00 for the end time (24 hrs format). Unfortunately, the calendar was sent time as 23:00 - 00:00.
Could you please advise what should I do.
Thanks...
Hello Diane,
Thanks a lot for the post. It was really helpful. I used your template for making a vacation calendar for a team and it works. However, if i make some modifications in the excel sheet and run the macro again, it duplicates all entries which were previously entered. How can i avoid this and import only the new changes?
The worksheet has 5 columns in the following order: Calendar, Last Name, First Name, Start Date, End Date
FYI: I'm already working with the version where you mentioned skips previous imports.
Thanks in advance!