CODEWITHSUNDEEP
excelvbaoutlook
Tmacjoshua
Tmacjoshua

Reputation: 87

Loop through all Outlook inboxes including shared inboxes error

I have code that will search through a user's Outlook and reply to an email depending on the Subject phrase you input in the worksheet cell. I did have it working a couple days ago, but now I can not seem to get it to work (was deleted). Once run, an error message will continuously display for code line "Set olitems = flrd.Items", saying "Object variable or With block variable not set". I think the problem is the End if but wherever I place it either the code does nothing or the same error displays.

The only other problem with the working code (when it worked) was that it populated more than once. I wish it to populate only one time.

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 i & " DisplayName - " & allStores(i).DisplayName
On Error GoTo 0

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

If Not storeInbox Is Nothing Then
End if
     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
 Set Fldr = StoreInbox

Next

ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing

End Sub

Upvotes: 2

Views: 119

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66235

Firstly, get rid of the On Error Resume Next line. Secondly, Fldr variable is never set. Did you mean to use storeInbox variable instead? 

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 i & " DisplayName - " & allStores(i).DisplayName
On Error GoTo 0

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

If Not storeInbox Is Nothing Then

     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 if

Next

ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing

End Sub

Upvotes: 1

Related Questions