Changing appointment to AllDayEvent,. Recipients get meeting request for specific tim

[toddcjohnson68]

I want to do the following with a submitted meeting request:
1) Change appointment to AllDayEvent=True (seems to clear out the time portion of Date field) and BusyStatus=Free so recipients see the event at the top of their calendar without being blocked
2) Create an appointment with time originally submitted in meeting request BusyStatus=Busy to block users own calendar.

I am successfully creating new appointment and the changes appear successful in the meeting. The items are correct in my calendar. However, the meeting request goes to the recipients with the original time.

Here is what I am doing:

'Only applies to new Meeting Requests
If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then

Dim meeting As MeetingItem
Dim appt As AppointmentItem
Set meeting = Item
Set appt = meeting.GetAssociatedAppointment(False)


'Does this have a OOO/WFH custom property set?
'This property is set by another macro.
If Not (appt.ItemProperties.Item("OOORequest") Is Nothing) And appt.ItemProperties("OOORequest") Then

Dim olApp As Outlook.Application
Dim new_appt As AppointmentItem
Dim newStart As Date
Dim newEnd As Date

Set new_appt = Outlook.Application.CreateItem(olAppointmentItem)

'If recurring meeting, duplicate recurrence pattern for new appointment
If appt.IsRecurring Then

Dim RPOrig As RecurrencePattern
Dim RPNew As RecurrencePattern

Set RPOrig = appt.GetRecurrencePattern
Set RPNew = new_appt.GetRecurrencePattern
RPNew = RPOrig

End If

'Save dates
newStart = appt.Start
newEnd = appt.End

'Reset original appointment Date properties to dates only (no times)
Dim strDate As String
strDate = CStr(DatePart("m", newStart)) + "/" + CStr(DatePart("d", newStart)) + "/" + CStr(DatePart("yyyy", newStart))

'Set Meeting request to not bother other users
With appt
'.Start = CDate(strDate)
'.End = CDate(strDate)
.ReminderSet = False
.AllDayEvent = True
.BusyStatus = olFree
.ResponseRequested = False
.ForceUpdateToAllAttendees = True
.Save
End With

meeting.Save
meeting.Send

With new_appt
.Subject = appt.Subject + " appt"
.BusyStatus = olOutOfOffice
.ReminderSet = False
.Start = newStart
.End = newEnd
.Save
.Send
End With

'Release resources
Set new_appt = Nothing
Set olApp = Nothing
End If

'Release resources
'Set meeting = Nothing
'Set appt = Nothing
End If


End Sub

 

[toddcjohnson68]

Turns out that problem is the ItemSend event passes in the Meeting object by value which means that I cannot update it. I have since moved to the AppointmentItem.Send event and things are working better.