Deleting Duplicate Outlook Calendar Items.

[NMS]

Hi I am new to VBA and I have created some code that allows a user to create an appointment and place it within a shared folder as well. However if the user modifies the appointment time for instance it will update the calendar with the new time but won't delete the old appointment. I would be grateful if you could help me go about deleting the old time when a new time is created. The code I have which creates appointments is:


Private WithEvents m_cal As Outlook.Items
'


Private Sub Copy(ByRef Item As Object)


Dim folderID As String 'ID for folder
folderID = "0000..." 'Set folder ID value
Dim storeID As String 'ID for store
storeID = "000000..." 'Set store ID value

Dim objCalendarFolder As Outlook.Folder 'Folder for additional calendar
Set objCalendarFolder = Outlook.Application.Session.GetFolderFromID(folderID, storeID)


If (Not objCalendarFolder Is Nothing) Then
Dim currentAppt As AppointmentItem
If TypeOf Item Is AppointmentItem Then
Set currentAppt = Item
Else
Set currentAppt = Item.GetAssociatedAppointment(False) 'Call get current item function
End If

Call currentAppt.Copy.Move(objCalendarFolder)
Set currentAppt = Nothing
End If


End Sub




Private Sub Application_Startup()
Set m_cal = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub


Private Sub m_cal_ItemAdd(ByVal mt As Object)
If mt.MeetingStatus = olNonMeeting Then
Call Question(mt)
Exit Sub
End If

If mt.MeetingStatus = olMeeting Or mt.MeetingStatus = olMeetingReceived Then
If mt.ResponseStatus = olResponseAccepted Or mt.ResponseStatus = olResponseOrganized Then
Call Question(mt)
End If
End If
End Sub


Private Sub Question(ByRef Item As Object)
On Error GoTo ErrorHandler 'Error Handler

Dim prompt As String
prompt = "Would you like to copy this meeting to a group calendar?"

If MsgBox(prompt, vbYesNo + vbQuestion, "Copy Meeting") = vbYes Then 'MsgBox display
Call Copy(Item)
End If
Exit Sub


ErrorHandler:
MsgBox Err.Number & "/" & Err.Description & "/" & Err.Source & "/" & Erl
End Sub