Interface between Access 365 with Calendar in 365 Business

[JohnPapa]

I have modified the code a bit, and the Collection is now only the appointments that need to be deleted (not all the appointments). When I call the Delete sub, all appointments are deleted except the last one, which is deleted if I call the Delete sub again.

As it has been suggested by Gasman, when you delete, it is best done with a loop backwards. I do this when it comes to recordsets, but here we have a collection. I did some investigating and one way would be to create a reversed collection. Will try this out and see if it helps.

The modified code is aa follows. I mark the appointments that need to be deleted by having Location = 123.

I do not know if looping backwards in the appointment collection would help and if yes how to do it. The specific excerpt is

EDIT: If only automatically added appointments exist (only entries with Location = 123), all appointments are deleted.

    For Each olAppointmentItem In olFilterAppointments
            olAppointmentItem.Delete
    Next

Private Sub Command89_Click()
Call subDeleteAutoGereratedAppointment(#2/16/2025 12:00:01 AM#, #2/16/2025 11:59:59 PM#, "user1@kosmosbusiness.onmicrosoft.com")
'Call subDeleteAutoGereratedAppointment(#2/16/2025 12:00:01 AM#, #2/16/2025 11:59:59 PM#, "user1@kosmosbusiness.onmicrosoft.com")
End Sub
Sub subDeleteAutoGereratedAppointment(dtmStart As Date, dtmEnd As Date, strOutlookEmail As String)
    Dim olApp              As Object
    Dim nsMAPI                   As Object
    Dim olAppointments         As Object
    Dim olFilterAppointments   As Object
    Dim olAppointmentItem      As Object
    Dim blnIsOutlookRunning        As Boolean
    Dim strDateRange As String

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Err.Clear
        Set olApp = CreateObject("Outlook.Application")
        blnIsOutlookRunning = False
    Else
        blnIsOutlookRunning = True
    End If
    On Error GoTo Error_Handler
    DoEvents

    Set nsMAPI = olApp.GetNamespace("MAPI")
    Set olAppointments = nsMAPI.Folders(strOutlookEmail).Folders("Calendar")
 
     Dim str123 As String
     str123 = "123"

    strDateRange = "[Start] >= '" & Format$(dtmStart, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [Start] <= '" & Format$(dtmEnd, "mm/dd/yyyy hh:mm AMPM") & "' AND [Location] =  '" & str123 & "'    "
    
    Set olFilterAppointments = olAppointments.Items.Restrict(strDateRange)
  
    'Debug.Print olFilterAppointments.Count & " appointments found."
 
    For Each olAppointmentItem In olFilterAppointments
            olAppointmentItem.Delete
    Next

    If blnIsOutlookRunning = False Then
        olApp.Quit
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set olAppointmentItem = Nothing
    Set olFilterAppointments = Nothing
    Set olAppointments = Nothing
    Set nsMAPI = Nothing
    Set olApp = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFutureOutlookEvents" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

 

[Gasman]

When you have your collection, you must be able to count how many are in there?
Just loop backwards with a loop counter.
Now whether the index starts at 0 or 1, you will have to find out.

 

[JohnPapa]

When you have your collection, you must be able to count how many are in there?
Just loop backwards with a loop counter.
Now whether the index starts at 0 or 1, you will have to find out.

The number of filtered (to be deleted) appointments is olFilterAppointments.Count

When you say Loop do you mean using For Each ...Next.

I will remind that we are talking about a Collection with no apparent unique ID and the current Delete loop is

For Each olAppointmentItem In olFilterAppointments
    olAppointmentItem.Delete
Next

 

[Gasman]

I have never used collections, but I would be looking at something along these lines

Dim i As Integer
For i = olFilterAppointments.Count to 1 step -1
    olAppointmentItem(i).Delete
Next

Not sure if that should be olFilterAppointments(i).Delete?, but you can work that out.

 

[JohnPapa]

I have never used collections, but I would be looking at something along these lines

Dim i As Integer
For i = olFilterAppointments.Count to 1 step -1
    olAppointmentItem(i).Delete
Next

Not sure if that should be olFilterAppointments(i).Delete?, but you can work that out.

The following works fine and deletes ALL the filtered appointments. Many thanks. I will post both the Delete and Export Code again.

Dim i As Integer
For i = olFilterAppointments.Count To 1 Step -1
    olFilterAppointments(i).Delete
Next