title: Loading appointments to a non-default Outlook calendar from Excel
body: <p>I have a project to put employees leave schedules into a shared or global calendar.</p>
  
  <p>The appointments save to my default calendar.</p>
  
  <p>I have tried a few different approaches. This is the current approach:</p>
  
  <pre><code>Sub Create_Outlook_2()
  ' Create the Outlook session
  
  Dim oApp As Object
  Dim oNameSpace As Namespace
  Dim oFolder As Object
  Dim myApt As AppointmentItem
  
  Set oApp = New Outlook.Application
  Set oNameSpace = oApp.GetNamespace("MAPI")
  Set oFolder = oNameSpace.GetFolderFromID("000000007CF129E6C6BAA74F9B2AB399FABB280E01006EC36FFC70429B4EAE1875321A4609670078C4FA00320000").Items.Add(olAppointmentItem)
  
  With oFolder
  '    Set myOutlook = CreateObject("Outlook.Application")
  '    ' Set data collection to take from "Leave Table" sheet
      Dim wsSrc As Worksheet
      Set wsSrc = Sheets("Leave Table")
      ' Start looping at row 3 (first two rows are for readability)
      r = 3
      ' Do/while set condition
      Do Until Trim(wsSrc.Cells(r, 1).Value) = ""
          ' Create event item
          Set myApt = oApp.CreateItem(1)
          ' Set the event properties
          ' Set Subject line of event
          With myApt
              .Subject = "Time Off " &amp; wsSrc.Cells(r, 1).Value &amp; " " &amp; wsSrc.Cells(r, 2).Value
             ' Set start time
              .Start = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 8).Value
             ' Set end time
              .End = DateValue(wsSrc.Cells(r, 3)) + wsSrc.Cells(r, 9).Value
             ' Turn reminders off
              .ReminderSet = False
             ' Set busy status to free
              .BusyStatus = 0
             ' Have the body of the event read as the decription from the leave form in Viewpoint
              .Body = wsSrc.Cells(r, 4).Value
             ' Save event in owners calendar
              .Save
  
          End With
         ' Move to next row
          r = r + 1
         ' Repeat do/while loop until condition is no longer valid
      Loop
  
  End With
  End Sub
  </code></pre>