Adding vacation days to Outlook in bulk from Excel


A friend sent me a spreadsheet with a list of dates. He wants to put them on his calendar as vacation days, but doesn't want to do it manually. Hooray, another free job.

The list of dates starts in cell A2, with A1 being a header row. Nice! I love those kinds of worksheets.


All we need now is a little procedure to loop through the range and add an appointment to the Outlook calendar, making it a vacation day. Here's what I came up with.

Sub CreateAppointments(Optional subject As String = "Vacation", _
    Optional columnLetter As String = "A")

Dim cell As Excel.Range
Dim rng As Excel.Range
Dim wholeColumn As Excel.Range
Dim startingCell As Excel.Range
Dim oApp As Object  ' Outlook.Application
Dim appt As Object  ' Outlook.AppointmentItem
Dim wkbk As Excel.Workbook
Dim wksht As Excel.Worksheet
Dim lastRow As Long
Dim arrData As Variant
Dim i As Long

  ' late bound constants
Const olAppointmentItem As Long = 1
Const olOutOfOffice As Long = 3

  ' get range of dates
  Set wkbk = ActiveWorkbook
  Set wksht = wkbk.ActiveSheet
  Set wholeColumn = wksht.Range(columnLetter & ":" & columnLetter)
  lastRow = wholeColumn.End(xlDown).Row - 2
  Set startingCell = wksht.Range(columnLetter & "2")
  Set rng = wksht.Range(startingCell, startingCell.Offset(lastRow))

  ' start Outlook
  Set oApp = GetOutlookApp

  If oApp Is Nothing Then
    MsgBox "Could not start Outlook.", vbInformation
    Exit Sub
  End If

  ' read range into array in one go
  arrData = Application.Transpose(rng.Value)

  ' loop through array, not range
  For i = LBound(arrData) To UBound(arrData)

    ' create new appt and set appropriate properties
    Set appt = oApp.CreateItem(olAppointmentItem)

    With appt
      .AllDayEvent = True  ' block out the whole day
      .body = subject
      .Start = arrData(i)  ' no need to set End Property for all-day events
      .subject = subject
      .BusyStatus = olOutOfOffice
      .ReminderSet = False  ' no need for reminder, right?
    End With
  Next i

End Sub

Function GetOutlookApp() As Object
' return Outlook.Application object
  On Error Resume Next
  Set GetOutlookApp = CreateObject("Outlook.Application")
End Function

The procedure lets you decide what you want to call each appointment. I assume "Vacation", but if you were using this procedure to block out a series of dates for a professional development conference, you would call it something else.

You can also specify the column, if the data is somewhere other than column A. For example, if your dates were in column H starting in cell H2, with H1 as the header cell, you would call the function like this:

Call CreateAppointments(, "H")

The first thing the procedure does is determine the range being used to hold the dates. After starting Outlook, the range is read into a Variant (array) and then looped. For a simple task like this we could have also used a 'For Each cell in Range'-type loop, but I chose to actually follow best practices and use an array instead of touching the worksheet repeatedly.

For each appointment, we set three key properties: AllDayEvent, Start and BusyStatus. These are the ones that will make each one a vacation day.

Sample Usage

Sub TestCreateAppt()

  Call CreateAppointments("On my way to Excel DevCon 2010")

End Sub

Download sample workbook

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »

Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 1 Comment(s) on Adding vacation days to Outlook in bulk from Excel:

  1. Hi JP,

    I tried your code and actually like this approach. It worked great as coded.
    The way I would like like to be able to use it, would be to have it only log dates from the list that are equal to or later that the current date and gave a reminder a selectable number of days ahead of the first planned date from the list.

    I am figure out a few things in Excel VBA, but coding for Outlook commands is above my skill level.
    Any advice or help you could offer would be much appreciated.

    Thanks so much for sharing!


This article is closed to any future comments.
Excel School