Removing Recurrence

[JoeMarfice]

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(olFolderCalendar)

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

[JoeMarfice]

It turns out that as soon as you call GetRecurrencePattern.StartTime/EndTime (and possibly other Properties & Methods of GetRecurrencePattern.), you change the stupid Appointment to a stupid recurring Appointment (which, by default, are weekly). You can't remove the recurrence until you save the stupid appointment.

Stupid Microsoft VBA.

Anyway, the following change to the above code will allow it to remove recurrences:

[VBA]If (Format(.GetRecurrencePattern.StartTime, "HH:MM") = "00:00") _
And (.GetRecurrencePattern.RecurrenceType = olRecursWeekly) Then
' Save the stupid appointment, so we can change it.
.Save
' Now change it, and save the change.
.ClearRecurrencePattern
.Save

' [etc.][/VBA]