You do know that using GetRecurrencePattern() will make an item recurring
even if it isn't recurring, don't you? You should check first for
itmAppointment.IsRecurring() and only get the recurrence pattern if the item
is already recurring.

I don't know if that's the problem but I'd make that change anyway. I'd also
eliminate the access to RecurrenceState since you aren't doing anything with
it and not even actually reading its value.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"JoeMarfice" wrote in message
news
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