Clash Royale CLAN TAG#URR8PPP

VBA to loop through all inboxes including shared inboxes

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") & "MicrosoftSignatures"

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


Set Fldr...

Set olItems = mySubfolder.Items

mySubfolder

Dim mySubfolder As Outlook.Folder

2 Answers
2

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


Set Fldr = storeInbox

on error resume next

on error goto 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


Set olItems = mySubfolder.Items

F8

locals window

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.