VBA para recorrer todas las bandejas de entrada, incluidas las bandejas de entrada compartidas

Tengo un código de trabajo que responde a un correo electrónico en Outlook del usuario, según el asunto. Sin embargo, no puedo hacer que el código busque en todas las bandejas de entrada del usuario.

A partir de ahora solo buscará en la bandeja de entrada específica del usuario. Aquí está mi código, he buscado pero no puedo encontrar una solución que pueda comprender mi conocimiento de VBA.

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

    Set Fldr = Session.GetDefaultFolder(olFolderInbox)
    Set olItems = Fldr.Items

    olItems.Sort "[Received]", True

    For i = 1 To olItems.count
        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," & _
                        "<p style='font-family:calibri;font-size:14.5'>" & "Workflow ID:" & " " & _
                        Worksheets("Checklist Form").Range("B6") & "<p style='font-family:calibri;font-size:14.5'>" & _
                        Worksheets("Checklist Form").Range("B11") & "<p style='font-family:calibri;font-size:14.5'>" & _
                        "Regards," & "</p><br>" & signature & .HTMLBody
                    .Display
                    .Subject = "RO Finalized WF:" & Worksheets("Checklist Form").Range("B6") & " " & _
                        Worksheets("Checklist Form").Range("B2") & " -" & Worksheets("Fulfillment Checklist").Range("B3")
                End With

                Exit For
                olMail.Categories = "Executed"

            End If
        End If

    Next i

End Sub

Respuestas a la pregunta(2)

Su respuesta a la pregunta