Import Excel Appointments to Outlook Shared Calendar

Question

I am trying to import an appointment calendar in Excel with Excel VBA with the following format:

Subject        Start            End             Location
Breakfast      8/7/17 9:00 AM   8/7/17 9:30 AM  Cafe

I am encountering a "Run-time Error 438: Object doesn't support this property or method" at .Start = ThisWorkbook.Sheets(1).Cells(NextRow, 2) when I run this macro:

Sub TestCalendar()

Dim OLApp As Object
Dim OLName As Object
Dim OLFolder As Object
Dim OLAppt As Object
Dim NextRow As Long

Set OLApp = CreateObject("Outlook.Application")

Set OLName = OLApp.GetNamespace("MAPI")

Set OLFolder = OLName.GetDefaultFolder(9).Folders("Test")

NextRow = 2

Do Until Trim(ThisWorkbook.Sheets(1).Cells(NextRow, 1)) = ""

Set OLAppt = OLApp.CreateItem(olAppointmentItem)

With OLAppt

.Subject = ThisWorkbook.Sheets(1).Cells(NextRow, 1)
.Start = ThisWorkbook.Sheets(1).Cells(NextRow, 2)
.End = ThisWorkbook.Sheets(1).Cells(NextRow, 3)
.Location = ThisWorkbook.Sheets(1).Cells(NextRow, 4)
.Save
End With

NextRow = NextRow + 1
Loop

Set OLAppt = Nothing
Set OLFolder = Nothing
Set OLName = Nothing
Set OLApp = Nothing

End Sub

Answer 1

The following script worked for me.

Sub AddAppointments()
    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")

    ' Start at row 2
    r = 2

    Do Until Trim(Cells(r, 1).Value) = ""
        ' Create the AppointmentItem
        Set myApt = myOutlook.CreateItem(1)
        ' Set the appointment properties
        myApt.Subject = Cells(r, 1).Value
        myApt.Location = Cells(r, 2).Value
        myApt.Start = Cells(r, 3).Value
        myApt.Duration = Cells(r, 4).Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Trim(Cells(r, 5).Value) = "" Then
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = Cells(r, 5).Value
        End If
        If Cells(r, 6).Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
        Else
            myApt.ReminderSet = True
        End If
        myApt.Body = Cells(r, 7).Value
        myApt.Save
        r = r + 1
    Loop
End Sub

Here's a view of my setup.