Pull the changed outlook recurring exception names correctly

[slwtx2003]

It is a bit messy, but below, is my script. I sat down the other day and rewrote what I had before and I finally got it all to work. That is, with the exception of 1 very large detail. If I have a recurring appointment, and I change the name and time of one of the events then it pulls the original recurring appointments name. I am not very good at explaining, so I will give an example below.

Lets say, I have an appointment every Thursday to visit ClientA from 2pm - 5pm. I have to cancel because my friend gets tickets to the Blue Man Group. So.. I double click on the appointment, and tell it to change "Only this occurance". I move the appointment to 4pm - 7pm and change the name to Blue Man Group. When my script runs, it pulls that thursday appointment and puts the correct time, but it still shows the name as ClientA.

Oh.. And a big + if you can help me out with the script writing. I am still a bit green, and always appreciate feedback on how to do things better. Right now the script works but if I choose a large date array then it takes about 4-5 minutes to run.

do until TypeName(appointment) = "Nothing"
For x = 0 to ubound(datearray)
apptimesplit = split(timevalue(appointment.start), ":")
if apptimesplit(0) < 10 then
apptimesplit0 = "0" & apptimesplit(0)
else
apptimesplit0 = apptimesplit(0)
end if
apptime = apptimesplit0 & ":" & apptimesplit(1) & ":" & apptimesplit(2)
appstartsplit = split(datevalue(appointment.start), "/")
if appstartsplit(0) < 10 then
appstartmonth = "0" & appstartsplit(0)
else
appstartmonth = appstartsplit(0)
end if
if appstartsplit(1) < 10 then
appstartday = "0" & appstartsplit(1)
else
appstartday = appstartsplit(1)
end if
appstart = appstartmonth & "/" & appstartday & "/" & appstartsplit(2)
If appointment.RecurrenceState = 0 then
If DateValue(appointment.Start) = datearray(x) then
finaltally = finaltally & Appointment.subject & vbtab & datevalue(appointment.start) & vbtab & TimeValue(appointment.start) & vbtab & TimeValue(appointment.end) & vbtab & "1" & vbcrlf
end if
else
Set recurrencePattern = appointment.GetRecurrencePattern
on error resume next
Set recurringAppointment = recurrencePattern.GetOccurrence(datearray(x) & " " & apptime)
errorCode = err.Number
err.Clear
on error goto 0
If errorCode = 0 then
dim recappstartsplit, recappstartmonth, recappstartday, recappstart
recappstartsplit = split(datevalue(recurringappointment.start), "/")
if recappstartsplit(0) < 10 then
recappstartmonth = "0" & recappstartsplit(0)
else
recappstartmonth = recappstartsplit(0)
end if
if recappstartsplit(1) < 10 then
recappstartday = "0" & recappstartsplit(1)
else
recappstartday = recappstartsplit(1)
end if
recappstart = recappstartmonth & "/" & recappstartday & "/" & recappstartsplit(2)
if not instr(finaltally, Appointment.subject & vbtab & datevalue(recurringappointment.start) & vbtab & TimeValue(recurringappointment.start) & vbtab & TimeValue(recurringappointment.end)) then
finaltally = finaltally & Appointment.subject & vbtab & datevalue(recurringappointment.start) & vbtab & TimeValue(recurringappointment.start) & vbtab & TimeValue(recurringappointment.end) & vbtab & "2" & vbcrlf
end if
end if
Counter = recurrencePattern.Exceptions.Count
For y = 1 to Counter
Set Exception = RecurrencePattern.Exceptions.Item
dim excappstartsplit, excappstartday, excappstartmonth, excappstart
on error resume next
excappstartsplit = split(datevalue(exception.appointmentitem.start), "/")
if excappstartsplit(0) < 10 then
excappstartmonth = "0" & excappstartsplit(0)
else
excappstartmonth = excappstartsplit(0)
end if
if excappstartsplit(1) < 10 then
excappstartday = "0" & excappstartsplit(1)
else
excappstartday = excappstartsplit(1)
end if
excappstart = excappstartmonth & "/" & excappstartday & "/" & excappstartsplit(2)
if not instr(finaltally , appointment.subject & vbtab & datevalue(exception.appointmentitem.start) & vbtab & timevalue(exception.appointmentitem.start) & vbtab & timevalue(exception.appointmentitem.end)) then
if DateValue(exception.appointmentitem.start) = datearray(x) and exception.deleted = false then
finaltally = finaltally & Appointment.subject & vbtab & datevalue(exception.appointmentitem.start) & vbtab & timevalue(exception.appointmentitem.start) & vbtab & timevalue(exception.appointmentitem.end) & vbtab & "3" & vbcrlf
end if
end if
on error goto 0
Next
end if
Set recurringAppointment = Nothing
Next
set appointment = appointmentItems.GetNext
loop

 

[slwtx2003]

I figured it out. Under the exceptions area, the last part of the script, it needs to say Exception.AppointmentItem.Subject. I was sure that I had tried that before, but in any case, it works now.