Outlook VBA Stumbling Over "Undeliverable" Report-CodePudding

I have some VBA that works as follows. For messages that are selected in Outlook, it marks them as read, assigns a category and moves them to a subfolder. It works great UNLESS one of the selected items is a Mail Delivery System "Undeliverable" report. Those items are not marked-as-read, categorized or moved.

I tried to duplicate the primary FOR EACH action loop to look for olReportItem, but it still isn't making any changes to the undeliverable reports. (BTW, I realize that it is inefficient to have 2 separate loops, but am just doing it this way for testing purposes so I can keep all the beta code in one section.)

I am guessing that I am referencing those reports the wrong way, but I have googled away and can't find the solution. Any help appreciated. Thanks.

Sub TestMoveToSubfolder()
'With selected emails: (1) mark as read, (2) assign category, (3) move to subfolder

On Error Resume Next

    Dim thisFolder As Outlook.MAPIFolder
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim objStore As Store

    Set thisFolder = Application.ActiveExplorer.CurrentFolder
    Set objStore = thisFolder.Store
    Set objFolder = thisFolder.Folders("REFERENCE_DESIRED_FOLDER")
        
    'Be sure target folder exists
    If objFolder Is Nothing Then
        MsgBox "I can't find the designated subfolder.", vbOKOnly   vbExclamation, "INVALID SUBFOLDER"
        Exit Sub
    End If
    
    'Confirm at least one message is selected
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If
    
    'Loop through emails
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.UnRead = False
                objItem.Categories = "INSERT_DESIRED_CATEGORY"
                objItem.Move objFolder
            End If
        End If
    Next
    
    'TEST SECTION to work with undeliverable reports
        Dim objItem2 As Outlook.ReportItem
        
        'Loop through nondelivery reports
        For Each objItem2 In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem2.Class = olReportItem Then
                    objItem2.UnRead = False
                    objItem2.Categories = "INSERT_DESIRED_CATEGORY"
                    objItem2.Move objFolder
                End If
            End If
        Next
        
        Set objItem2 = Nothing
    
    Set thisFolder = Nothing
    Set objFolder = Nothing
    Set objItem = Nothing
    Set objStore = Nothing

End Sub

CodePudding user response：

The problem is related to declaring the objItem in the following way:

Dim objItem As Outlook.MailItem

Dim objItem2 As Outlook.ReportItem

To be able to iterate over all items selected in Outlook you need to declare the objItem as object in the code.

Typically to find out the exact line of code causing the issue you need to remove the following line:

On Error Resume Next

There also no need to have two separate loops, you may combine two conditions into the single loop:

Dim objItem As Object

'Loop through emails
For Each objItem In Application.ActiveExplorer.Selection      
  ' check for regular mail items
  If objItem.Class = olMail Then
     objItem.UnRead = False
     objItem.Categories = "INSERT_DESIRED_CATEGORY"
     objItem.Move objFolder
  End If
  ' check for report items
  If objItem.Class = olReportItem Then
     objItem.UnRead = False
     objItem.Categories = "INSERT_DESIRED_CATEGORY"
     objItem.Move objFolder
  End If
Next

CodePudding user response：

As I said in my comment, no olReportItem class exists. Declaring objItem As Variant (or As Object) will allow iteration between all selection clases (in a unique iteration. Something like that:

    Dim objItem 
    For Each objItem In appOutlook.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.UnRead = False
                objItem.Categories = "INSERT_DESIRED_CATEGORY"
                objItem.Move objFolder
            ElseIf objItem.Class = olReport Then
                Stop
                'do whatever you need here...
            End If
        End If
    Next

CodePudding user response：

Thanks so much to @niton, @FaneDura and @Eugene Astafiev for your comments. I have incorporated those into revised code, and made one other change to address an error when the item was already in the target folder. The code is now working except that when the item is already in the target folder, sometimes everything works fine, but sometimes the category is not added (even though the item is marked as read). If I step through the code I can see that it gets to the categories line and then moves past it without error, but no category is assigned. I never experienced this particular issue previously. Is there a problem with assigning a category to an Object as opposed to an Outlook.MailItem?

Sub TestMoveToSubfolder()
'With selected emails: (1) mark as read, (2) assign category, (3) move to subfolder

'On Error Resume Next

    Dim thisFolder As Outlook.MAPIFolder
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Object 'could also define as Variant
    Dim objStore As Store

    Set thisFolder = Application.ActiveExplorer.CurrentFolder
    Set objStore = thisFolder.Store
    Set objFolder = thisFolder.Folders("REFERENCE_DESIRED_FOLDER")
    
    'Be sure target folder exists
    If objFolder Is Nothing Then
        MsgBox "I can't find the designated subfolder.", vbOKOnly   vbExclamation, "INVALID FOLDER"
        Exit Sub
    End If
    
    'Require that this procedure be called only when a message is selected
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If
    
    'Loop through selected items
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.UnRead = False
                objItem.Categories = "INSERT_DESIRED_CATEGORY"
                If thisFolder <> objFolder Then objItem.Move objFolder
            ElseIf objItem.Class = olReport Then
                objItem.UnRead = False
                objItem.Categories = "INSERT_DESIRED_CATEGORY"
                If thisFolder <> objFolder Then objItem.Move objFolder
            End If
        End If
    Next
    
    Set thisFolder = Nothing
    Set objFolder = Nothing
    Set objItem = Nothing
    Set objStore = Nothing

End Sub