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!