The attempted operation failed. An object could not be found. Excel and Outlook VBA

[Joao Inacio]

Hello Everyone,

I have created a macro that gathers all the timings from a specific subfolder on a specific date from a shared mailbox and personal sent folder.
When checking the timings from the personal sent folder there is no issues, but when checking from the subfolders from the shared mailbox sometimes randomly I get the error "Run-time error' -2147221233 (8004010f)':
The attempted operation failed. An object could not be found."

Also, after some testing noticed that force-closing Outlook helps minimizing the issue since it forces to check directly from Outlook server.
This is a corporate mailbox shared by the team in different locations, and it is necessary to use VPN to access the mailbox.

This is a portion of the code focused where the error occurs:

Option Explicit
Public ufEventsDisabled As Boolean
Dim cvCheckBoxs As Collection
Dim CV1 As Worksheet
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Outlook.Namespace
Dim Folder As Outlook.Folder
Dim WB As Workbook
Dim pass, path As String
Dim count As Integer

Private Sub CommandButton4_Click()

Dim Mail As Outlook.MailItem
Dim cnt, counter, i, index, ILS, HO, HOOLD, MONI As Integer
Dim first, plus, found As Boolean
Dim user, filter, time As String
Dim FilteredM As Object

Outlook.Application.Quit
Set WB = Workbooks("Tool.xlsm")
Set CV1 = Sheet1
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
path = WB.path
count = GetCount2
plus = False
found = False
counter = 1

CV1.Unprotect

user = Mid(OutlookNamespace.Session.DefaultStore, 1, InStr(OutlookNamespace.Session.DefaultStore, "@") - 1)

Do While (CV1.Range("F" & count).Value) <> ""
    
    time = CV1.Range("C" & count).Value
    counter = 1
    
    If CV1.Range("A" & count).Value = "Day" Then
        filter = "[ReceivedTime] > '" & CDate(CV1.Range("B400").Value) & " 05:30' AND [ReceivedTime] <= '" & CDate(Format(Now(), "dd/mm/yyyy hh:mm")) & "'"
    Else
        filter = "[ReceivedTime] > '" & CDate(CV1.Range("B401").Value) & " 17:30' AND [ReceivedTime] <= '" & CDate(Format(Now(), "dd/mm/yyyy hh:mm")) & "'"
    End If
        
    Select Case CV1.Range("V" & count).Value            
        Case "2. Folder"
            Set Folder = OutlookNamespace.Folders("CorpoEmail")
            Set Folder = Folder.Folders("Inbox")
            Set Folder = Folder.Folders("2. Folder")  'error occurs here
            Set FilteredM = Folder.Items.Restrict(filter)
        
            Do While index <= FilteredM.count
                Set Mail = FilteredM(index)
                If InStr(Mail.Subject, CV1.Range("F" & count).Value) And Mail.Sender <> "CorpoEmail" Then
                    CV1.Range("C" & count).Value = Format(Mail.ReceivedTime, "hh:mm")
                    CV1.Range("B" & count).Value = Format(Mail.ReceivedTime, "\ dd\/mm\/yyyy\")
                    found = True
                    Exit Do
                End If
                index = index + 1
            Loop
            Set Folder = Nothing
            Set FilteredM = Nothing
            index = 1
        
            If Not found Then
                Set Folder = OutlookNamespace.Folders("CorpoEmail")
                Set Folder = Folder.Folders("Inbox")
                Set Folder = Folder.Folders("4. Folder")   'error occurs here[COLOR=rgb(184, 49, 47)][B][/B][/COLOR]
                Set FilteredM = Folder.Items.Restrict(filter)
                
                Do While index <= FilteredM.count
                    Set Mail = FilteredM(index)
                    If InStr(Mail.Subject, CV1.Range("F" & count).Value) And Mail.Sender <> "CorpoEmail" Then
                        CV1.Range("C" & count).Value = Format(Mail.ReceivedTime, "hh:mm")
                        CV1.Range("B" & count).Value = Format(Mail.ReceivedTime, "\ dd\/mm\/yyyy\")
                        found = True
                        Exit Do
                    End If
                    index = index + 1
                Loop
            Set Folder = Nothing
            Set FilteredM = Nothing
            index = 1
            End If
            
            If Not found Then
                Set Folder = OutlookNamespace.Folders("CorpoEmail")
                Set Folder = Folder.Folders("Inbox")
                Set Folder = Folder.Folders("5. Folder")  'error occurs here
                Set FilteredM = Folder.Items.Restrict(filter)
                
                Do While index <= FilteredM.count
                    Set Mail = FilteredM(index)
                    If InStr(Mail.Subject, CV1.Range("F" & count).Value) And Mail.Sender <> "CorpoEmail@corpo.com" Then
                        CV1.Range("C" & count).Value = Format(Mail.ReceivedTime, "hh:mm")
                        CV1.Range("B" & count).Value = Format(Mail.ReceivedTime, "\ dd\/mm\/yyyy\")
                        found = True
                        Exit Do
                    End If
                    index = index + 1
                Loop
                Set Folder = Nothing
                Set FilteredM = Nothing
                index = 1
            End If
            
        Case "1. Folder"
            Set Folder = OutlookNamespace.Folders("CorpoEmail")
            Set Folder = Folder.Folders("Inbox")
            index = 1
            Folder = Folder.Folders("1. Folder")   'error occurs here
            
            counter = 0
            
            Set FilteredM = Folder.Items.Restrict(filter)
            index = 1
                
                Do While index <= FilteredM.count
                    Set Mail = FilteredM(index)
                    If InStr(Mail.Subject, CV1.Range("F" & count).Value) And Mail.Sender <> "CorpoEmail@corpo.com" Then
                        CV1.Range("C" & count).Value = Format(Mail.ReceivedTime, "hh:mm")
                        CV1.Range("B" & count).Value = Format(Mail.ReceivedTime, "\ dd\/mm\/yyyy\")
                        Exit Do
                    End If
                    index = index + 1
                Loop
            Set Folder = Nothing
            Set FilteredM = Nothing
            index = 1
    End Select

So as you can see, the macro has no issues finding the CorpoEmail shared mailbox, and the Inbox of it but fails to recognize the subfolder of the Inbox.
I would be very thankful if you could guide me on the right approach to prevent this error from happening again.

Thank you very much all!