title: Appointment invite wont send VBA
body: <p>I don't work in VBA very often and I modified the code below to fit my needs and it works up to the point of actually sending out the appointment invite. When I open it in Outlook the attendee is listed but I have to send it manually from Outlook. I don't get any errors or any indication that it didn't send. Any other tips on optimization and conventions are also appreciated, I'm sure it's painful to look at for some of the better programmers. Also, I know it's similar to other questions on the site but they are different enough I'm having a hard time figuring out what I need to do exactly, so your patience is appreciated.</p>
  
  <p>Thanks :)</p>
  
  <pre><code>Sub RegisterAppointmentList()
  'Adds a list of appointments to the Calendar in Outlook
  Dim olApp As New Outlook.Application
  Dim olAppItem As Outlook.AppointmentItem
  Dim r As Long
  
  On Error Resume Next
  Worksheets("Schedule").Activate 'Insures that the correct sheet is selected, needs to be updated if rename
  Set olApp = GetObject("", "Outlook.Application")
  On Error GoTo 0
  
  If olApp Is Nothing Then 'If GetObject fails then creates a new Application Object
  
      On Error Resume Next
      Set olApp = CreateObject("Outlook.Application")
      On Error GoTo 0
  
      If olApp Is Nothing Then
          MsgBox "Outlook is not available!"
          Exit Sub
      End If
  
  End If
  
  r = 2 'First row with appointment data in the active worksheet, ignores headers
  
  'Declares variables for Outlook Parameters
  
  Dim myStart, myEnd, myUnitBefore
  Dim myAttendee As Outlook.Recipient
  
  While Len(Cells(r, 1).Text) &lt;&gt; 0 And Len(Cells(r, 4).Text) &lt;&gt; 0
  
      'Sets Default Values of 8:00am and 8:30am as start and end times if no value found
      If Cells(r, 5) = "" Then
          myStart = DateValue(Cells(r, 4).Value) + "8:00:00 AM"
      Else:
          myStart = DateValue(Cells(r, 4).Value) + Cells(r, 5).Value    'Concatenates Date and Start Time to single value
      End If
  
      If Cells(r, 6) = "" Then
          myEnd = DateValue(Cells(r, 4).Value) + "8:30:00 AM"
      Else
          myEnd = DateValue(Cells(r, 4).Value) + Cells(r, 6).Value 'Concatenates Date and End Time to single value
      End If
  
      'Set "Minutes Before" if "Days" "Hours" or "Weeks" are selected.
      If Cells(r, 9) = "Hours" Then
          myUnitBefore = 60
      ElseIf Cells(r, 9) = "Days" Then
          myUnitBefore = 24 * 60
      ElseIf Cells(r, 9) = "Weeks" Then
          myUnitBefore = 24 * 60 * 7
      Else
          myUnitBefore = 1
      End If
  
      Set olAppItem = olApp.CreateItem(olAppointmentItem) 'Creates a new appointment
  
      With olAppItem
  
          On Error Resume Next
          .Subject = Cells(r, 1)
          .Location = Cells(r, 2)
          .Body = .Subject &amp; " - " &amp; Cells(r, 3).Value
          .Start = myStart
          .End = myEnd
          .ReminderSet = Cells(r, 7)
          .ReminderMinutesBeforeStart = Cells(r, 8).Value * myUnitBefore
          .Categories = Cells(r, 10).Text &amp; " Category"   'Allows using dropdown to set Category.
          Set myAttendee = olAppItem.Recipients.Add(Cells(r, 11))
  
          If Cells(r, 12) = "Free" Then
              .BusyStatus = olFree
          Else
              .BusyStatus = olBusy
          End If
  
          On Error GoTo 0
  
          .Save 'Saves the new appointment to the default folder
          .Send 'Doesn't seem to work...
  
      End With
  
      r = r + 1 'Cycle until all rows of events have been created
  
  Wend
  
  'Clear Objects when done
  Set olAppItem = Nothing
  Set olApp = Nothing
  </code></pre>