Excel VBA - insert calendar appointmens from Excel

Hi

Which version of Office are you using?

You will need a loop to work through the rows and use the below sub to add each entry.

The routine below creates an Outlook calendar event. Most event types are supported including recurring events. See the documentation in the code for a description of the parameters.

[Begin Code Segment]

Public Sub AddOutlookEvent( _
      ByVal StartDateTime As Date, _
      ByVal Subject As String, _
      Optional ByVal EndDateTime As Date, _
      Optional ByVal Duration As Long, _
      Optional ByVal Location As String, _
      Optional ByVal Body As String, _
      Optional ByVal ReminderMinutesBeforeStart As Long = 15, _
      Optional ByVal Remind As Boolean, _
      Optional ByVal BusyStatus As Outlook.OlBusyStatus = Outlook.olBusy, _
      Optional ByVal AllDayEvent As Boolean, _
      Optional ByVal Recurring As Boolean, _
      Optional ByVal Recurrence As Outlook.OlRecurrenceType, _
      Optional ByVal Interval As Long = 1, _
      Optional ByVal DaysOfWeek As Outlook.OlDaysOfWeek, _
      Optional ByVal DayOfMonth As Long, _
      Optional ByVal MonthOfYear As Long, _
      Optional ByVal Instance As Long, _
      Optional ByVal RecurrenceInterval As Long = 1, _
      Optional ByVal Occurrences = 0, _
      Optional ByVal RecursUntil As Date _
   )

' Add a calendar event to Outlook. To use include a reference to Microsoft
' Outlook X Object Library.
'
' Syntax
'
' AddOutlookEvent(StartDateTime, Subject, [EndDateTime], [Duration], [Location], [Body], [ReminderMinutesBeforeStart],
'   [Remind], [BusyStatus], [AllDayEvent], [Recurring], [Recurrence], [Interval], [DaysOfWeek], [DayOfMonth],
'   [MonthOfYear], [Instance], [RecurrenceInterval], [Occurrences], [RecursUntil]
'
' StartDateTime - The start date and time of the event.
'
' Subject - The subject line of the event.
'
' EndDateTime - The end date and time of the event. Optional. If Duration is
'   specified then Duration has precedence. If neither EndDateTime or Duration
'   are specified then Duration defaults to 60 minutes.
'
' Location - The location of the event. Optional. Default is empty.
'
' Body - The body of the event. Optional. Default is empty.
'
' ReminderMinutesBeforeStart - The number of minutes prior to the start of the
'   to display the reminder. Optional. If omitted then
'   ReminderMinutesBeforeStart defaults to 15 minutes.
'
' Remind - Set to True to remind, False to not remind. Optional. Default is
'   False.
'
' BusyStatus - Set to one of olBusy, olFree, olOutOfOffice, or olTentative.
'
' AllDayEvent - Set to True if an all day event, False otherwise. Optional.
'   Default it False.
'
' Recurring - Set to True if a recurring event, False otherwise. Optional.
'   Default is False.
'
' Recurrence - Set to one of olRecursDaily, olRecursMonthly, olRecursMonthNth,
'   olRecursWeekly, olRecursYearly, or olRecursYearNth. Optional. Default is
'   olRecursDaily. Ignored if Recurring is False.
'
' Interval - Set to the period interval between recurring events. Optional.
'   Default is 1. Ignored if Recurring is False.
'
' DaysOfWeek - Set to the days of the week on which the event occurs. Set to
'   one or more of olSunday, olMonday, ..., olSaturday. Sum multiple values to
'   set multiple days of the week. Optional. Default is olMonday. Applicable if
'   Recurrence is olRecursDaily, olRecursMonthNth, olRecursWeekly, or
'   olRecursYearNth. Ignored if Recurring is False.
'
' DayOfMonth - The day of the month on which the event occurs. Optional.
'   Default is the current day of month. Applicable if Recurrence is
'   olRecursMonthly or olRecursYearly. Ignored if Recurring is False.
'
' MonthOfYear - The month of the year on which the event occurs. Optional.
'   Default is the current month. Applicable if Recurrence is olRecursYearly or
'   olRecursYearNth. Ignored if Recurring is False.
'
' Instance - The count for which the recurrence pattern is valid for a given
'   interval. Optional. Default is the instance of the current date. Applicable
'   if recurrence is olRecursMonthNth and olRecursYearNth.
'
' RecurrenceInterval - The number of periods between occurences. Optional.
'   Default is 1. Applicable if recurrence is olRecursDaily, olRecursMonthly,
'   olRecursMonthNth, or olRecursWeekly.
'
' Occurrences - The total number of occurences. Optional. Default is zero. If
'   zero then RecursUntil is used. If RecursUntil is also omitted then the
'   event recurs indefinately.
'
' RecursUntil - The last occurrence date. Optional. Default is zero. If zero
'   and Occurrences is also zero then the event recurs indefinately.
   
   Dim OutlookApplication As Outlook.Application
   Dim Appointment As Outlook.AppointmentItem
   Dim RecurrencePattern As Outlook.RecurrencePattern
   
   Set OutlookApplication = New Outlook.Application
   Set Appointment = OutlookApplication.CreateItem(Outlook.olAppointmentItem)
   
   With Appointment
      .Start = StartDateTime
      If Duration > 0 Then
         .Duration = Duration
      ElseIf EndDateTime > 0 Then
         .End = EndDateTime
      Else
         .Duration = 60
      End If
      .Subject = Subject
      .Location = Location
      .Body = Body
      .ReminderMinutesBeforeStart = ReminderMinutesBeforeStart
      .ReminderSet = Remind
      .BusyStatus = BusyStatus
      .AllDayEvent = AllDayEvent
      If Recurring Then
         Set RecurrencePattern = .GetRecurrencePattern
         If DaysOfWeek = 0 Then DaysOfWeek = olMonday
         If DayOfMonth = 0 Then DayOfMonth = Day(Now)
         If MonthOfYear = 0 Then MonthOfYear = Month(Now)
         If Instance = 0 Then Instance = Int((Day(Now) - 1) / 7) + 1
         With RecurrencePattern
            .RecurrenceType = Recurrence
            Select Case Recurrence
               Case olRecursDaily
                  .Interval = Interval
                  .DayOfWeekMask = DaysOfWeek
               Case olRecursMonthly
                  .Interval = Interval
                  .DayOfMonth = DayOfMonth
               Case olRecursMonthNth
                  .Interval = Interval
                  .Instance = Instance
                  .DayOfWeekMask = DaysOfWeek
               Case olRecursWeekly
                  .Interval = Interval
                  .DayOfWeekMask = DaysOfWeek
               Case olRecursYearly
                  .DayOfMonth = DayOfMonth
                  .MonthOfYear = MonthOfYear
               Case olRecursYearNth
                  .Instance = Instance
                  .DayOfWeekMask = DaysOfWeek
                  .MonthOfYear = MonthOfYear
            End Select
            .PatternStartDate = Int(StartDateTime)
            .StartTime = StartDateTime - Int(StartDateTime)
            If Occurrences = 0 Then
               If RecursUntil > 0 Then
                  .PatternEndDate = Int(RecursUntil)
               Else
                  .NoEndDate = True
               End If
            Else
               .Occurrences = Occurrences
            End If
         End With
      End If
      .Save
   End With
   
End Sub

End Code Segment]

Below is a late binding version of the above routine that does not require a library reference to Outlook.

[Begin Code Segment]

Public Sub AddOutlookEvent( _
      ByVal StartDateTime As Date, _
      ByVal Subject As String, _
      Optional ByVal EndDateTime As Date, _
      Optional ByVal Duration As Long, _
      Optional ByVal Location As String, _
      Optional ByVal Body As String, _
      Optional ByVal ReminderMinutesBeforeStart As Long = 15, _
      Optional ByVal Remind As Boolean, _
      Optional ByVal BusyStatus As Long = 2, _
      Optional ByVal AllDayEvent As Boolean, _
      Optional ByVal Recurring As Boolean, _
      Optional ByVal Recurrence As Long, _
      Optional ByVal Interval As Long = 1, _
      Optional ByVal DaysOfWeek As Long, _
      Optional ByVal DayOfMonth As Long, _
      Optional ByVal MonthOfYear As Long, _
      Optional ByVal Instance As Long, _
      Optional ByVal RecurrenceInterval As Long = 1, _
      Optional ByVal Occurrences = 0, _
      Optional ByVal RecursUntil As Date _
   )

' Add a calendar event to Outlook. To use include a reference to Microsoft
' Outlook X Object Library.
'
' Syntax
'
' AddOutlookEvent(StartDateTime, Subject, [EndDateTime], [Duration], [Location], [Body], [ReminderMinutesBeforeStart],
'   [Remind], [BusyStatus], [AllDayEvent], [Recurring], [Recurrence], [Interval], [DaysOfWeek], [DayOfMonth],
'   [MonthOfYear], [Instance], [RecurrenceInterval], [Occurrences], [RecursUntil]
'
' StartDateTime - The start date and time of the event.
'
' Subject - The subject line of the event.
'
' EndDateTime - The end date and time of the event. Optional. If Duration is
'   specified then Duration has precedence. If neither EndDateTime or Duration
'   are specified then Duration defaults to 60 minutes.
'
' Duration - The duration of the event in seconds. Optional. Default is zero.
'
' Location - The location of the event. Optional. Default is empty.
'
' Body - The body of the event. Optional. Default is empty.
'
' ReminderMinutesBeforeStart - The number of minutes prior to the start of the
'   to display the reminder. Optional. If omitted then
'   ReminderMinutesBeforeStart defaults to 15 minutes.
'
' Remind - Set to True to remind, False to not remind. Optional. Default is
'   False.
'
' BusyStatus - Set to one of olBusy = 2, olFree = 0, olOutOfOffice = 3, or
'   olTentative = 1.
'
' AllDayEvent - Set to True if an all day event, False otherwise. Optional.
'   Default it False.
'
' Recurring - Set to True if a recurring event, False otherwise. Optional.
'   Default is False.
'
' Recurrence - Set to one of olRecursDaily = 0, olRecursMonthly = 2,
'   olRecursMonthNth = 3, olRecursWeekly = 1, olRecursYearly = 5, or
'   olRecursYearNth = 6. Optional. Default is olRecursDaily. Ignored if
'   Recurring is False.
'
' Interval - Set to the period interval between recurring events. Optional.
'   Default is 1. Ignored if Recurring is False.
'
' DaysOfWeek - Set to the days of the week on which the event occurs. Set to
'   one or more of olSunday = 1, olMonday = 2, olTuesday = 4, olWednesday = 8,
'   olThursday = 16, olFriday = 32, olSaturday = 64. Sum multiple values to
'   set multiple days of the week. Optional. Default is olMonday. Applicable if
'   Recurrence is olRecursDaily, olRecursMonthNth, olRecursWeekly, or
'   olRecursYearNth. Ignored if Recurring is False.
'
' DayOfMonth - The day of the month on which the event occurs. Optional.
'   Default is the current day of month. Applicable if Recurrence is
'   olRecursMonthly or olRecursYearly. Ignored if Recurring is False.
'
' MonthOfYear - The month of the year on which the event occurs. Optional.
'   Default is the current month. Applicable if Recurrence is olRecursYearly or
'   olRecursYearNth. Ignored if Recurring is False.
'
' Instance - The count for which the recurrence pattern is valid for a given
'   interval. Optional. Default is the instance of the current date. Applicable
'   if recurrence is olRecursMonthNth and olRecursYearNth.
'
' RecurrenceInterval - The number of periods between occurences. Optional.
'   Default is 1. Applicable if recurrence is olRecursDaily, olRecursMonthly,
'   olRecursMonthNth, or olRecursWeekly.
'
' Occurrences - The total number of occurences. Optional. Default is zero. If
'   zero then RecursUntil is used. If RecursUntil is also omitted then the
'   event recurs indefinately.
'
' RecursUntil - The last occurrence date. Optional. Default is zero. If zero
'   and Occurrences is also zero then the event recurs indefinately.
   
   Dim OutlookApplication As Object ' Outlook.Application
   Dim Appointment As Object ' Outlook.AppointmentItem
   Dim RecurrencePattern As Object ' Outlook.RecurrencePattern
   
   Set OutlookApplication = CreateObject("Outlook.Application") ' New Outlook.Application
   Set Appointment = OutlookApplication.CreateItem(1) ' Outlook.olAppointmentItem = 1
   
   With Appointment
      .Start = StartDateTime
      If Duration > 0 Then
         .Duration = Duration
      ElseIf EndDateTime > 0 Then
         .End = EndDateTime
      Else
         .Duration = 60
      End If
      .Subject = Subject
      .Location = Location
      .Body = Body
      .ReminderMinutesBeforeStart = ReminderMinutesBeforeStart
      .ReminderSet = Remind
      .BusyStatus = BusyStatus
      .AllDayEvent = AllDayEvent
      If Recurring Then
         Set RecurrencePattern = .GetRecurrencePattern
         If DaysOfWeek = 0 Then DaysOfWeek = 2 ' olMonday = 2
         If DayOfMonth = 0 Then DayOfMonth = Day(Now)
         If MonthOfYear = 0 Then MonthOfYear = Month(Now)
         If Instance = 0 Then Instance = Int((Day(Now) - 1) / 7) + 1
         With RecurrencePattern
            .RecurrenceType = Recurrence
            Select Case Recurrence
               Case 0
                  .Interval = Interval
                  .DayOfWeekMask = DaysOfWeek
               Case 2
                  .Interval = Interval
                  .DayOfMonth = DayOfMonth
               Case 3
                  .Interval = Interval
                  .Instance = Instance
                  .DayOfWeekMask = DaysOfWeek
               Case 1
                  .Interval = Interval
                  .DayOfWeekMask = DaysOfWeek
               Case 5
                  .DayOfMonth = DayOfMonth
                  .MonthOfYear = MonthOfYear
               Case 6
                  .Instance = Instance
                  .DayOfWeekMask = DaysOfWeek
                  .MonthOfYear = MonthOfYear
            End Select
            .PatternStartDate = Int(StartDateTime)
            .StartTime = StartDateTime - Int(StartDateTime)
            If Occurrences = 0 Then
               If RecursUntil > 0 Then
                  .PatternEndDate = Int(RecursUntil)
               Else
                  .NoEndDate = True
               End If
            Else
               .Occurrences = Occurrences
            End If
         End With
      End If
      .Save
   End With
   
End Sub

[End Code Segment]

Kevin

Great. Thanks very much