title: Create Outlook appointment in specific Calendar from Excel
body: <p>I am trying to create three Outlook appointments in a specific (shared) calendar.</p>
  
  <p>The events will be all-day events. I want the dates for the current row to be added to the calendar. All three dates will be in the same row on the spreadsheet.</p>
  
  <p>The code creates the appointment but the for loop is not working. The only event that is created is the last date.</p>
  
  <pre><code>Sub Makeapt()
  Set myOutlook = CreateObject("Outlook.Application")
  
  Set myApt = myOutlook.createitem(1)
  Dim i As Integer    
  For i = 3 To 5
      myApt.Subject = Cells(ActiveCell.Row, 1).Value
      myApt.Start = Cells(ActiveCell.Row, i).Value
      myApt.Save
  Next i
  
  End Sub
  </code></pre>
  
  <p>I solved the problem. Appt still goes to the default calendar, but that is actually preferable. </p>
  
  <pre><code>Sub Makeapt()
  
  Dim warning
  warning = MsgBox("You are about to create Outlook appointments for subject #" &amp; Cells(ActiveCell.Row, 3) &amp; ". Is that right?", vbOKCancel)
  If warning = vbCancel Then Exit Sub
  
  Set myOutlook = CreateObject("Outlook.Application")
  Set ID = Cells(ActiveCell.Row, 3)
  Dim i As Integer
  
  For i = 7 To 9
      Set myApt = myOutlook.createitem(1)
      myApt.Subject = "Subject #" &amp; ID
      myApt.Start = Cells(ActiveCell.Row, i).Value
      myApt.Save
  Next i
  
  End Sub
  </code></pre>