VBA to loop through all inboxes including shared inboxes

Question

I have working code that replies to an email in the user's Outlook, based on the subject. However I am not able to have the code search through all the user's inboxes.

As of now it will only search through the user's specific inbox. Here is my code, I have searched around but I can not find a solution that my knowledge of VBA can comprehend.

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

You should just be able to add another for loop right after the `Set Fldr...` line ` For Each mSubfolder In Fldr.Folders` and lastly you'd have to change the line after it to `Set olItems = mySubfolder.Items` — Marcucciboy2, Aug 09 '18 at 17:32
if that doesn't work check out this answer https://stackoverflow.com/a/2273050/2727437 — Marcucciboy2, Aug 09 '18 at 17:34
Is it supposed to be mSubfolder? or mysubfolder and also do I need to declare it? — Tmacjoshua, Aug 09 '18 at 18:36
oops sorry about that typo there. I meant for them both to be "my". `mySubfolder` was just an example name for a folder object, so it'd be `Dim mySubfolder As Outlook.Folder` — Marcucciboy2, Aug 09 '18 at 18:37
I can not seem to get it to work. Would you mind answering the question with my code and the code lines needed attached. I must be missing something. Thanks Marc — Tmacjoshua, Aug 09 '18 at 18:49
Note that where you have the two consecutive lines `Exit For` followed by ` olMail.Categories = "Executed"`, I believe those two lines should be swapped so that the `Exit For` is just below `olMail.Categories = "Executed"` — Marcucciboy2, Aug 09 '18 at 19:19

niton · Accepted Answer · 2018-08-17T17:15:01.190

1

You may reference any Inbox like this:

Option Explicit

Sub Inbox_by_Store()

Dim allStores As Stores
Dim storeInbox As Folder

Dim j As Long

Set allStores = Session.Stores

For j = 1 To allStores.count

    Debug.Print j & " DisplayName - " & allStores(j).DisplayName

    Set storeInbox = Nothing

    ' Some stores will not have an inbox
    ' Bypass possible expected error if there is no inbox in the store
    On Error Resume Next
    ' Note this is one of the rare acceptable uses for On Error Resume Next
    Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
    ' Turn off error bypass as soon as it is no longer needed
    On Error GoTo 0

    If Not storeInbox Is Nothing Then
        storeInbox.Display

        ' your code here instead of storeInbox.Display
        ' Set Fldr = storeInbox

    End If

Next

ExitRoutine:
    Set allStores = Nothing
    Set storeInbox = Nothing

End Sub

edited Aug 17 '18 at 17:15

answered Aug 10 '18 at 14:33

niton

8,771
21
32
52

Thanks Niton, sorry but where would I incorporate that in my code. Will this code read all inboxes? – Tmacjoshua Aug 10 '18 at 14:44
I am not sure how to input more than one "For i = 1" Is this possible? – Tmacjoshua Aug 10 '18 at 17:09
Change this outer loop to something else, perhaps j. – niton Aug 10 '18 at 17:13
So I input the code before "Set Fldr = Session.GetDefaultFolder(olFolderInbox)" but I get an error for "For J=1 to allstores.count" Not sure if I am placing it in the correct place. Could you maybe edit your answer with my code and your code together? Thanks – Tmacjoshua Aug 10 '18 at 17:25
Did you see more than one inbox when you tried this code without modification? – niton Aug 10 '18 at 17:32
If you were referring to your code alone, yes it opened up all the inboxes in the user's Outlook.If it could search through them all and grab the email with the subject like my code does for the user's specific inbox that would be great – Tmacjoshua Aug 10 '18 at 17:41
1

Put your code with one change `Set Fldr = storeInbox` where indicated. – niton Aug 10 '18 at 17:45
This code line is causing a bug, I tried inputting in the inbox name where " DisplayName - " is but with no success. What should I change? The code line is "Debug.Print i & " DisplayName - " & allStores(i).DisplayName" – Tmacjoshua Aug 13 '18 at 12:53
2

Any Debug.Print is not necessary to run code. Without knowing why there is an error, you can place `on error resume next` just before and `on error goto 0` immediately after. It may still be useful for debugging purposes, if it does not produce helpful output delete it. – niton Aug 13 '18 at 13:05
Ok I moved the End if and it works. It will however pop up a Microsoft Warning with text "A program is trying to access e-mail address information stored in Outlook. If this is unexpexted, click Deny and verify your antivirus software is up-to-date" The options are Allow and Deny, but Allow only has a maximum time of up to 10 minutes. This code also opens up 4 of the same emails. – Tmacjoshua Aug 13 '18 at 13:17
I found a way to avoid the warning, but the email populates 4 times, which I think may be related to the amount of inboxes I have in my outlook – Tmacjoshua Aug 13 '18 at 16:18

Marcucciboy2 · Answer 2 · 2018-08-09T19:05:47.130

0

I don't really have the ability to test out whether this works, but these are the changes that I mentioned in the comments, I hope they work!

Sub Display()

    '...

    Set Fldr = Session.GetDefaultFolder(olFolderInbox)

    Dim mySubfolder As Outlook.Folder       'added
    For Each mySubfolder In Fldr.Folders    'added

        Set olItems = mySubfolder.Items     'changed

        For i = 1 To olItems.count

        '...

        Next i

    Next mySubfolder                        'added

End Sub

edited Aug 09 '18 at 19:05

answered Aug 09 '18 at 18:54

Marcucciboy2

3,156
3
20
38

I get the error (Object Required) related to code line "Set olitems =myFldr.Folders" – Tmacjoshua Aug 09 '18 at 19:04
@Tmacjoshua oops, yeah it was supposed to be `Set olItems = mySubfolder.Items` – Marcucciboy2 Aug 09 '18 at 19:06
When I input a subject, to find an email nothing happened. When I did not input a subject about 7 random emails showed up from different times, when it is supposed to sort by the most recent email. – Tmacjoshua Aug 09 '18 at 19:12
1

Ah well I'm not totally sure how to solve that, then :/ It seems like you might have to spend a bit of time using `F8` and the `locals window` to debug and see where everything is going https://www.excel-easy.com/vba/examples/debugging.html – Marcucciboy2 Aug 09 '18 at 19:17

VBA to loop through all inboxes including shared inboxes

2 Answers2

Linked