'CdoDefaultFolderCalendar = 9

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNameSpace("MAPI")
Set objCalendarFolder = myNameSpace.GetDefaultFolder(9)
Set objCalendars = objCalendarFolder.Items

'On Error Resume Next

respond = MsgBox("Begin Deleting Birthdays in your Outlook Calendar?", vbOKCancel)
If respond = 2 Then
	MsgBox "Exiting without checking Calendar."
	Wscript.quit
End If

NumItems = objCalendars.Count
MsgBox "You have a total of " & NumItems & " Outlook calender entries to be searched to find birthdays."

DelCount = 0
For Each objItem In objCalendars
	If (Instr(1,ucase(objItem.Subject),"'S BIRTHDAY") > 0) Then
'		MsgBox "Deleting entry for " & objItem.Subject & ": " & objItem.Location & ": " & objItem.Start
		objItem.Delete
		DelCount = DelCount + 1	
	End If
Next
   
MsgBox "Number of Calendar Birthday Appointments deleted:" & DelCount

' Clean up
Set objItem = Nothing
Set objCalendarFolder = Nothing
Set objCalendars = Nothing
Set myNameSpace = Nothing
Set myOlApp = Nothing
wscript.quit