I have a large number (600+) of appointments that have become mislabeled as
weekly recurring appointments. Their start times are all correct, and their
end times are mostly one day later (all day appointments); all of them are in
the past.

Unfortunately, now all of these appointments appear as current events
(NoEndDate).

I tried using the following code to remove the recurrences, and preserve the
start date and times, but it seems to do nothing (although the code inside
the inner if-then loop is activated 600+ times).

What am I missing?

************************************************** ********

Sub FixWeeklyAllDayAppointments()

Dim lngNumShiftedAppointments As Long
Dim datPatternStartDate As Date
Dim mapiAppointments As MAPIFolder
Dim itmAppointment As AppointmentItem

lngNumShiftedAppointments = 0

Set mapiAppointments = Outlook.Application. _
GetNamespace("MAPI").GetDefaultFolder(olFolderCale ndar)

For Each itmAppointment In mapiAppointments.Items
With itmAppointment
If (.AllDayEvent = False) Then

If (Format(.GetRecurrencePattern.StartTime, "HH:MM") = "00:00") _
And (.GetRecurrencePattern.RecurrenceType = olRecursWeekly)
Then
' These particular events have been buggered.
.ClearRecurrencePattern
.RecurrenceState
.Save
lngNumShiftedAppointments = lngNumShiftedAppointments + 1
End If
End If
End With
Next

Set mapiAppointments = Nothing
Set itmAppointment = Nothing

MsgBox lngNumShiftedAppointments " bad Appointments were found & corrected."

Exit Sub