Cannot Add Items to an Items Collection????

[John Riddle]

Hello,

I've got code in my VBA module that has been working great for me and all
users for over a year now and suddenly we are getting errors such as: Error
287 Application-defined or Object-defined Error.

Here is my code:

Sub CreateAppointment(ByVal propname)
Dim AppointmentFolder As MAPIFolder
Dim AppointmentItems As Items
Dim NewAppointment As AppointmentItem

On Error GoTo NoAppointment
Select Case propname
Case "Phone Interview"
strPhoneID = m_objTask.UserProperties("Phone EntryID")
strPhoneStoreID =
Application.Session.GetDefaultFolder(olFolderCalendar).StoreID
Set myAppointment = Application.Session.GetItemFromID(strPhoneID,
strPhoneStoreID)

Case "1st Interview"
str1stID = m_objTask.UserProperties("1st EntryID")
str1stStoreID =
Application.Session.GetDefaultFolder(olFolderCalendar).StoreID
Set myAppointment = Application.Session.GetItemFromID(str1stID,
str1stStoreID)

Case "2nd Interview"
str2ndID = m_objTask.UserProperties("2nd EntryID")
str2ndStoreID =
Application.Session.GetDefaultFolder(olFolderCalendar).StoreID
Set myAppointment = Application.Session.GetItemFromID(str2ndID,
str2ndStoreID)

Case "3rd Interview"
str3rdID = m_objTask.UserProperties("3rd EntryID")
str3rdStoreID =
Application.Session.GetDefaultFolder(olFolderCalendar).StoreID
Set myAppointment = Application.Session.GetItemFromID(str3rdID,
str3rdStoreID)

End Select

ChangeAppointment myAppointment, propname

Exit Sub

NoAppointment:
Set AppointmentFolder =
Application.Session.GetDefaultFolder(olFolderCalendar)
Set AppointmentItems = AppointmentFolder.Items
Set NewAppointment = AppointmentItems.Add()
PopulateAppointment NewAppointment, propname

End Sub

The Error occurs at the line:

Set NewAppointment = AppointmentItems.Add()

I've tried:

Set NewAppointment = AppointmentItems.Add(olAppointmentItem)

still no good. This has just started happening after working flawlessly for a
long time.

Any suggestions?

Thanks,

John