Private Sub DeleteAppointmentItemBySubject(strAppSubject As String)
' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.
Set objOlook = CreateObject("Outlook.Application")
Set objNamespace = objOlook.GetNamespace("MAPI")
objNamespace.Logon , , False, False
Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
On Error Resume Next
Set objAPPT = objFolder.Items(strAppSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete
MsgBox lngDeletedAppointements & " appointment(s) DELETED.", vbInformation, "DETETE Appointments"
Bye:
Set objAPPT = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOlook = Nothing
Exit Sub
CannotFindObject:
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye
End Sub