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

Joao Inacio

New Member
Joined
Jan 28, 2019
Messages
5
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:

VBA Code:
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!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top