Have VBA loop through all inboxes in Outlook including shared inboxes

Question

My goal with this code is to reply to a specific email in the user's outlook depending on the subject(B8). Essentially have the code loop through all the user's inboxes including shared inboxes to find the email.

The first code I have will go into the user's outlook but only their main inbox and pull the email to reply to. This works without error.

Sub Display()
    Dim Fldr As Outlook.Folder
    Dim olfolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim olReply As Outlook.MailItem
    Dim olitems As Outlook.Items
    Dim i As Long
    Dim signature As String
    Dim olitem As Object


    Set Fldr = Session.GetDefaultFolder(olFolderInbox)

    Set olitems = Fldr.Items


    olitems.Sort "[Received]", True
    For i = 1 To olitems.Count
        Set olitem = olitems(i)
        If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
        Set olMail = olitem
    signature = Environ("appdata") & "\Microsoft\Signatures\"
    If Dir(signature, vbDirectory) <> vbNullString Then
        signature = signature & Dir$(signature & "*.htm")
    Else:
        signature = ""
    End If
    signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll

    Set olMail = olitems(i)
        If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B8")) <> 0 Then
                If Not olMail.Categories = "Executed" Then
                Set olReply = olMail.ReplyAll
                With olReply
                 .HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & "Hi Everyone," & "Regards," & "</p><br>" & signature & .HTMLBody

                 .Display
                 .Subject               
    End With

                Exit For
                olMail.Categories = "Executed"
                Exit For
                End If
        End If
    SkipToNext:
       Next i

End Sub

This second section of code is my trial and error as well as the use of other resources attempt to have the code loop through all the inboxes of the user. The thing is it doesn't do anything anymore.

I did have working code for this scenario, then I mistakenly saved over it and I have not been successful in getting it back working. Below is as close as I have been able to get.

Any suggestions would be greatly appreciated.

The second script seems to be skipping from "Set olitems = Fldr.Items" to the bottom End If.

I thought maybe to move the End if right below "If not storeinbox Is Nothing Then" but the error "Object variable or With block variable not set" occurs.

When I do change the code line (While making the change above also) "Set Fldr = Storeinbox" to "Set Fldr = Session.GetDefaultFolder(olFolderInbox)" emails will populate, but only in the user's specific inbox(Does not pick up subject text, just most recent email).

I have added additional code to the second script

       Set olitem = olitems(i)
       If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
       Set olMail = olitem

Which was missing. This will populate the email for the user's specific email address by the subject. If I type in a subject from another inbox then nothing will happen but it will go through the code with no errors.

Getting closer, but still nothing for the shared inboxes.

Sub Display()
    Dim Fldr As Outlook.Folder
    Dim olfolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim olReply As Outlook.MailItem
    Dim olItems As Outlook.Items
    Dim i As Integer
    Dim signature As String
    Dim allStores As Stores
    Dim storeInbox As Folder
    Dim j As Long

    Set allStores = Session.Stores

    For j = 1 To allStores.Count
    On Error Resume Next
    Debug.Print j & " DisplayName - " & allStores(j).DisplayName
    On Error GoTo 0

    Set storeInbox = Nothing
    On Error Resume Next
    Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
    On Error GoTo 0

    If Not storeInbox Is Nothing Then
    Set Fldr = storeinbox
     Set olItems = Fldr.Items


    olItems.Sort "[Received]", True

    For i = 1 To olItems.Count
    Set olitem = olitems(i)
        If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
        Set olMail = olitem
        signature = Environ("appdata") & "\Microsoft\Signatures\"

        If Dir(signature, vbDirectory) <> vbNullString Then
        signature = signature & Dir$(signature & "*.htm")
        Else
            signature = ""
        End If

         signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll

        Set olMail = olItems(i)

        If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B8")) <> 0 Then
            If Not olMail.Categories = "Executed" Then
                Set olReply = olMail.ReplyAll

                With olReply
                    .HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & "Hi Everyone," &
                    "Regards," & "</p><br>" & signature & .HTMLBody
                 .Display
                 .Subject
                End With

                Exit For
                olMail.Categories = "Executed"

            End If
        End If

    Next
    End If

    ExitRoutine:
    Set allStores = Nothing
    Set storeInbox = Nothing
    SkipToNext:
    Next j
End Sub

Answer 1

If you Set allStores = Nothing inside the j loop it will only be something in the first iteration.

Option Explicit

' Think of Option Explicit as being mandatory
' Tools | Options
' Editor tab
' Checkbox "Require Variable Declaration"
' Option Explict will generate automatically on new modules
' You may type it in at the top of an existing module
' This as well points out possible spelling errors in the variables


Sub Display()

    'In Excel set reference to Outlook Object Library

    Dim Fldr As Outlook.Folder

    Dim olMail As Outlook.MailItem
    Dim olItem As Object

    Dim olReply As Outlook.MailItem
    Dim olItems As Outlook.Items

    Dim signature As String

    Dim i As Long
    Dim j As Long

    Dim allStores As Stores
    Dim storeInbox As Folder

    signature = Environ("appdata") & "\Microsoft\Signatures\"

    If Dir(signature, vbDirectory) <> vbNullString Then
        signature = signature & Dir$(signature & "*.htm")
        signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
    Else
        signature = ""
    End If

    ' Usually works with Outlook open.
    ' If this proves to be unreliable,
    '  you may need a CreateObject("Outlook.Application")
    Set allStores = Session.Stores

    For j = 1 To allStores.Count

        ' No need to bypass wrong index error here
        ' The error has been fixed by using j not i
        Debug.Print j & " DisplayName - " & allStores(j).DisplayName

        ' Reset storeInbox to nothing or it will remain the previous
        '  when there is an error on the current store
        ' This is one example of why to be careful with On Error Resume Next
        Set storeInbox = Nothing

        On Error Resume Next
        ' bypass error if store does not have an inbox
        Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
        On Error GoTo 0

        If Not storeInbox Is Nothing Then

            Set Fldr = storeInbox
            Set olItems = Fldr.Items

            ' Not needed?
            'olItems.Sort "[Received]", True

            For i = 1 To olItems.Count

                Set olItem = olItems(i)

                If TypeOf olItem Is Outlook.MailItem Then

                    Set olMail = olItem

                    If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B8")) <> 0 Then

                        If Not olMail.Categories = "Executed" Then

                            Set olReply = olMail.ReplyAll

                            With olReply
                                .HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & "Hi Everyone," & _
                                  "Regards," & "</p><br>" & signature & .HTMLBody
                                .Display

                                ' Generates a compile error. Appears not needed.
                                '.Subject
                            End With

                            olMail.Categories = "Executed"
                            olMail.Display 'olMail.Save

                        End If
                    End If
                End If
            Next
        End If
    Next j

ExitRoutine:
    Set allStores = Nothing
    Set storeInbox = Nothing

End Sub