' This code finds an meeting occurance and uses it to cancel the entire meeting series and
' have "Cancelled:" in front of the subject lines on the update messages sent to the recipient(s).
' To use:
'  Create a recurring meeting inside the date/time range below with the subject "testabc".
'  Invite an attendee.
'  Change the time of one occorance and send the update.
'  Have the attendee use OWA/Outlook/etc to accept.
'  Now run the code.
   
' TODO:
'     Create a VB6 form
'     Add a button and paste-in the code below.
' Note: CDO 1.21 is not supported under .NET code.
' Note: CDO 1.21 needs to run in-network.
' Note: Be sure to be on the latest version of CDO 1.21.


    Dim objSession As MAPI.Session
    Dim ObjMessage As MAPI.Message
    Dim objRecipient As MAPI.Recipient
    Dim oAppointment As MAPI.AppointmentItem
    Dim oCalendarFolder As MAPI.Folder
    Dim objOrig As AppointmentItem
    Dim objRecPatt As RecurrencePattern
    Dim objRecip As Recipient
 
    ' This is what I'm searching for
    Dim sFromDate As String
    Dim sToDate As String
    Dim sFindSubject As String
    sFromDate = "1/31/08"       ' TODO:  Change
    sToDate = "1/1/08"          ' TODO:  Change
    sFindSubject = "testabc"    ' TODO:  Change
       
    'Create the Session Object.
    Set objSession = New MAPI.Session
    Dim oMsgCollection As Object
    Dim oMsgFilter As Object
   
    'Logon using the session object.
    'objSession.Logon "", "", False, True, 0, True, "myserver" & vbLf & "mymailbox"
    objSession.Logon

    Set oCalendarFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
 
    ' We are going to filter to get appts....
    Set oMsgCollection = oCalendarFolder.Messages
    Set oMsgFilter = oMsgCollection.Filter
    oMsgFilter.Fields.Add CdoPR_START_DATE, sFromDate
    oMsgFilter.Fields.Add CdoPR_END_DATE, sToDate
    
    Dim oRecur As MAPI.RecurrencePattern
    Set oRecur = Nothing
    Dim bFound As Boolean
    bFound = False
   
    Set oAppointment = oMsgCollection.GetFirst
 
    Do While Not oAppointment Is Nothing
         
        ' TODO:  Add criteria as needed to the IF below to be certain you have the correct meeting.
        If oAppointment.Subject = sFindSubject And bFound = False Then
            Set oRecur = oAppointment.GetRecurrencePattern
            With oRecur
                oRecur.Parent.Subject = "Cancelled: " & oRecur.Parent.Subject
                oRecur.Parent.Importance = CdoHigh
                oRecur.Parent.BusyStatus = CdoFree
                oRecur.Parent.MeetingStatus = CdoMeetingCanceled
   
                oRecur.Parent.Update True, True
                oRecur.Parent.Send True, False, 0
                oRecur.Parent.Delete
            End With
            Set oRecur = Nothing
            bFound = True  ' Only need to do this once for the meeting.
         End If
            
         Set oAppointment = oMsgCollection.GetNext  ' Now, lets look at the next item.
    Loop
 
    Set oAppointment = Nothing
    
    Set oMsgCollection = Nothing
    Set oMsgFilter = Nothing
    Set oCalendarFolder = Nothing
    objSession.Logoff
    Set objSession = Nothing