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 **
Optional **
Resource **
** Note: The attendees and resources are limited to group in this macro. to send to multiple names, you need to resolve each name. More information follows this macro.
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
'## Start Recipient code
' 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
'## End Recipient code
' 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
Send meetings to multiple addresses
In order to send a meeting to multiple addresses you need to enter the addresses in the recipient cells separated by a semicolon.
Replace the recipient code in the macro above with the code.
'## Start Recipient code
' get the recipients
Dim objAttendee As Outlook.Recipient
Dim arrRecipients As Variant
Dim strRecipient As String
Dim countRecip As Long
Dim exCell
Dim exRecipents
Dim olType
For exCell = 1 To 3
Select Case exCell
Case 1
exRecipents = Cells(i, 10).Value
olType = olRequired
Case 2
exRecipents = Cells(i, 11).Value
olType = olOptional
Case 3
exRecipents = Cells(i, 12).Value
olType = olResource
End Select
arrRecipients = Split(exRecipents, ";")
If UBound(arrRecipients) >= 0 Then
For countRecip = 0 To UBound(arrRecipients)
strRecipient = arrRecipients(countRecip)
Debug.Print strRecipient, countRecip, olType
Set objAttendee = .Recipients.Add(strRecipient)
objAttendee.Type = olType
objAttendee.Resolve
Next
End If
Next
'## End Recipient code
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.
This is very helpful, thank you. How do I use 'Send meetings to multiple addresses' with a shared calendar (on an Exchange server)? I tried following the instructions listed here: https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
But, I still couldn't figure out what I needed to plug in and replace. Let's say the shared calendar is called "Test1." Can you please provide guidance on how to modify the 'Send meetings to multiple addresses' code accordingly?
Hello and thank you
Can this be done with google calendars?
Thank you !
Not directly with Gmail.com's calendar -you would need to add the events to a calendar in outlook and use a 3rd party sync utility (like Companionlink) to sync back to the online calendar.
I understand, but this software is paid one, so I cannot use it. Thank you!
You other option - import into Outlook desktop, save the calendar as an ics file and import it into gmail.
Also gmail should be able to import CSV files too.
the Calendar I'm trying to access is a "group calendar" that was created and has an e-mail address of e-mail@organization.onmicrosoft.com . I've tried a few ways to get to the calendar and have failed. Any thoughts?
Group calendars a weird. :) I have not tried adding to a group calendar recently, but in the past, you needed to select the group calendar, not call it by name.
Set CalFolder = olNs.ActiveExplorer.CurrentFolder
That's how I did it in How to Import Appointments into a Group Calendar (slipstick.com) - I don't recall if I tried using a macro like the ones on this page, but the source shouldn't matter.
I am using a script to send bulk emails to people in my company.
we want to send a teams meeting invite as attachment so they can optionally attend a training session on fridays.. coding a teams meeting invite is a not straight forward. i tried use SENDKEYS but i am far from my desired goal
Hello- from the CSV, what format should the time and dates be in so that it properly creates the meeting invite? I keep getting a type mismatch.
Use your default short date format and short time format.
I know 10/20/2021 and 10:45 AM work.
Hey there,
Thanks so much for the code, it is running great except for one random issue!
It seems to be adding duplicates of a select handful of events (among a total list of roughly 70). In excel, and in the code for this data, there is nothing different about these items, yet it still wants to keep duplicating the same each time I test importing the entire list. Some of these items are entered twice, others three times.
However, when I test only adding one of these items independently instead of the entire list (but inputting "Imported" for every other entry), it enters it in properly as a single instance.
I am clueless as to why this is happening and appreciate any help to solve it.
Thanks!
Hello,
I am getting this error: "The attempted operation failed. An object could not be found."
With the debug landing on this line: Set subFolder = CalFolder.Folders(arrCal)
Not sure what the issue would be, I have copied your column headers exactly and my Calendar Name matches to my Outlook calendar.
I appreciate the help.
Are you using calendar subfolders? If you are adding the events to your default calendar, you don't need that line.
Hi Diane,
I believe I am using a subfolder underneath "My Calendars" in Outlook - I will attach a photo. In my "Calendar Name" column I am using the name "Dates" as this is the calendar I would like to have appointments made in.
Also, when I try to run without the subfolder lines I am getting error 13, type mismatch on this line:
'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7)
Thanks,
David
Switch to the folder list - Ctrl+6 - to see where the folder is. Just being under My Calendars doesn't mean much.
Alternately, you can right click on the calendar, choose Properties - you'll see the path under the calendar name, in this format -
\\data file name\path\the calendar
in my screenshot - the Moon calendar is a subfolder of the Calendar.
Hi Diane,
It is correctly building the string for sFilter.Thank you so much for this code - it really is brilliant. I am able to add items to my calendar correctly.
However, when I try and delete items, it doesn't remove them from my calendar. Uncommenting the Debug.Print statements, it would appear that the ResItems count remains at 0 after the line:
I am not using an Outlook mailbox (instead I have configured my gmail account in Outlook appplication).
Could you please help me identify whey the ResItems line is not populating correctly?
Thanks again.
Paul
Is the calendar labeled 'this computer only'? I'll need to test it - it could be the calendar, it could be the code - deleting has been kind of buggy.
Hi Diane,
Yes, the calendar is labeled Calendar (This computer only). I have also noted that the calendar entry is only visible in Outlook. When I open the calendar entry, it provides the option to "Copy to My Calendar". However, even if I click that, the duplicate entry does not get deleted - or become visible outside of Outlook. The duplicate entry also still contains the option to "Copy to My Calendar".
Thanks for your help
Kind regards,
Paul
That is an IMAP calendar. Those calendars don't sync anywhere - they are only in Outlook desktop.