title: Have VBA loop through all inboxes in Outlook including shared inboxes
body: <p>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.</p>
  
  <p>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.</p>
  
  <pre><code>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") &amp; "\Microsoft\Signatures\"
      If Dir(signature, vbDirectory) &lt;&gt; vbNullString Then
          signature = signature &amp; Dir$(signature &amp; "*.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")) &lt;&gt; 0 Then
                  If Not olMail.Categories = "Executed" Then
                  Set olReply = olMail.ReplyAll
                  With olReply
                   .HTMLBody = "&lt;p style='font-family:calibri;font-size:14.5'&gt;" &amp; "Hi Everyone," &amp; "Regards," &amp; "&lt;/p&gt;&lt;br&gt;" &amp; signature &amp; .HTMLBody
  
                   .Display
                   .Subject               
      End With
  
                  Exit For
                  olMail.Categories = "Executed"
                  Exit For
                  End If
          End If
      SkipToNext:
         Next i
  
  End Sub
  </code></pre>
  
  <p>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. </p>
  
  <p>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. </p>
  
  <p>Any suggestions would be greatly appreciated. </p>
  
  <p>The second script seems to be skipping from <code>"Set olitems = Fldr.Items"</code> to the bottom End If. </p>
  
  <p>I thought maybe to move the End if right below <code>"If not storeinbox Is Nothing Then"</code> but the error <code>"Object variable or With block variable not set"</code> occurs. </p>
  
  <p>When I do change the code line (While making the change above also) <code>"Set Fldr = Storeinbox" to  "Set Fldr = Session.GetDefaultFolder(olFolderInbox)"</code> emails will populate, but only in the user's specific inbox(Does not pick up subject text, just most recent email).</p>
  
  <p>I have added additional code to the second script  </p>
  
  <pre><code>       Set olitem = olitems(i)
         If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
         Set olMail = olitem
  </code></pre>
  
  <p>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. </p>
  
  <p>Getting closer, but still nothing for the shared inboxes.</p>
  
  <pre><code>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 &amp; " DisplayName - " &amp; 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") &amp; "\Microsoft\Signatures\"
  
          If Dir(signature, vbDirectory) &lt;&gt; vbNullString Then
          signature = signature &amp; Dir$(signature &amp; "*.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")) &lt;&gt; 0 Then
              If Not olMail.Categories = "Executed" Then
                  Set olReply = olMail.ReplyAll
  
                  With olReply
                      .HTMLBody = "&lt;p style='font-family:calibri;font-size:14.5'&gt;" &amp; "Hi Everyone," &amp;
                      "Regards," &amp; "&lt;/p&gt;&lt;br&gt;" &amp; signature &amp; .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
  </code></pre>