Deleting an Outlook Appointment from Access VBA (1 Viewer)

' The Following variable assignments will pick-up the old booking data prior to the change in order
    ' to find and delete an Outlook booking. Variables have been caputured by the Sub Form_Current()procedure
    ' and declared Public in the basMyEmpID Standard Code Module.
    
            Dim goldLocation As String
            Dim goldStart As Date
            Dim goldDate As Date
            Dim goldName As String
 
            goldLocation = basMyEmpID.gstroldLocation 'golbal str variable
            goldStart = basMyEmpID.gdteoldStart 'global time varaible medium time
            goldDate = basMyEmpID.gdteoldDate   'global date variable short date
            goldName = basMyEmpID.gstroldName   'global strt variable
            
        
            
' Connection to Outlook Variables
 
                
                Dim objOlook As Outlook.Application
                Dim objNamespace As Outlook.NameSpace
                Dim objFolder As Outlook.MAPIFolder
                Dim objAppointment As Outlook.AppointmentItem
                Dim objOAppt As Outlook.Items
                Dim lngDeletedAppointements As Long
                Dim strSubject As String
                Dim strLocation As String
                Dim dteStartDate As Date
  
'******************************** Set Criteria for DELETION here ********************************
                strSubject = goldName
                strLocation = goldLocation
                dteStartDate = goldDate + goldStart
                
                
            
                MsgBox (strSubject & strLocation)
'************************************************************************************************
  
              Set objOlook = CreateObject("Outlook.Application")
             Set objNamespace = objOlook.GetNamespace("MAPI")
             Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
             
             For Each objAppointment In objFolder.Items
             If objAppointment.Subject = goldName And objAppointment.Location = goldLocation And _
             objAppointment.Start > dteStartDate Then
             objAppointment.Delete
             lngDeletedAppointements = lngDeletedAppointements + 1
            End If
            Next
            
MsgBox lngDeletedAppointements & " appointment(s) DELETED.", vbInformation, "DETETE Appointments"

                
              GoTo Ender
              Exit Sub

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

Call DeleteAppointmentItemBySubject(strAppSubject)

Call DeleteAppointmentItemBySubject("CydsTest")

Dim strAppSubject As String
strAppSubject = "CydsTest"
Call DeleteAppointmentItemBySubject(strAppSubject)