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