Outlook appointment from Excel

[DijitalAddict]

I'm trying to set appointments in Outlook from an Excel worksheet. However, I keep getting a Run-Time Error on the line: Set olApt = olApp.CreateItem(olAppointmentItem). The error is: Run-time error '287' application-defined or object-defined error.

I have referenced the Microsoft Outlook 11.0 Object Library. Funny thing is this worked through several tests. Then I closed Excel and re-opened it later and I keep getting this error.

I would appreciate any help.

My code is:
Private Sub btnCalendar_Click()

Range("A6").Activate 'first cell with data
Dim olApp As Outlook.Application
Dim olApt As Outlook.AppointmentItem

Set olApp = CreateObject("Outlook.Application")
Set olApt = olApp.CreateItem(olAppointmentItem)

Do While ActiveCell.Value <> "" 'if cell is not blank
If ActiveCell.Offset(0, 5).Value = "Y" Then
With olApt
.Start = DateValue(ActiveCell.Offset(0, 6).Value)
.AllDayEvent = True
.Subject = ActiveCell.Value
.Body = ActiveCell.Value & vbCrLf & ActiveCell.Offset(0, 1) & vbCrLf & ActiveCell.Offset(0, 2).Value & vbCrLf & ActiveCell.Offset(0, 3).Value & vbCrLf & vbCrLf & "Notes:" & vbCrLf & ActiveCell.Offset(0, 4).Value
.ReminderSet = False
.Save
End With
End If
ActiveCell.Offset(1, 0).Select 'move down one row
Loop 'keep going until ActiveCell is blank

Range("A6").Activate

Set olApt = Nothing
Set olApp = Nothing

End Sub

Thanks in advance,
DA