OutLook VBA Email or Notification Causes Out of Bounds Error

Question

I have some outlook VBA code which works fine to save attachments, however every time I get an email or a meeting notification in Outlook it causes an instant Out of Bounds error If I don't get any emails or notifications the code will run fine through to completion.

Is there a way to ensure that these notifications will not stop the code from running?

Option Explicit
Sub SaveAttachmentsFromSelectedItemsPDF2_ForNext()
    Dim currentItem As Object
    Dim currentAttachment As Attachment
    Dim saveToFolder As String
    Dim savedFileCountPDF As Long
    Dim i As Long
    Dim j As Long

    saveToFolder = "c:\dev\outlookexport" 'change the path accordingly
    savedFileCountPDF = 0

    For i = 1 To ActiveExplorer.Selection.Count
        Set currentItem = ActiveExplorer.Selection(i)
        For j = 1 To currentItem.Attachments.Count
            Set currentAttachment = currentItem.Attachments(j)
            If UCase(Right(currentAttachment.DisplayName, 5)) = UCase(".xlsx") Then
                currentAttachment.SaveAsFile saveToFolder & "\" & _
                Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 5) & ".xlsx"
                savedFileCountPDF = savedFileCountPDF + 1
            End If
            ' If For Next does not release memory automatically then
            ' uncomment to see if this has an impact
            'Set currentAttachment = Nothing
        Next
        ' If For Next does not release memory automatically then
        ' uncomment to see if this has an impact
        'Set currentItem = Nothing
    Next
    MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation
End Sub

This is what I tried to create from the answer below:

Option Explicit
Sub SaveAttachmentsFromSelectedItemsPDF2_ForNext()
    Dim currentItem As Object
    Dim currentAttachment As Attachment
    Dim saveToFolder As String
    Dim savedFileCountPDF As Long
    Dim i       As Long
    Dim j       As Long
    Dim x       As Long
    Dim myOlExp As Object
    Dim myOlSel As Object

    ' New
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    saveToFolder = "c:\dev\outlookexport"        'change the path accordingly
    savedFileCountPDF = 0

    For x = 1 To myOlSel.Count
        If myOlSel.Item(x).Class = OlObjectClass.olMail Then
                Set currentItem = ActiveExplorer.Selection(i)

                For j = 1 To currentItem.Attachments.Count

                    Set currentAttachment = currentItem.Attachments(j)

                    If UCase(Right(currentAttachment.DisplayName, 5)) = UCase(".xlsx") Then
                        currentAttachment.SaveAsFile saveToFolder & "\" & _
                        Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 5) & ".xlsx"
                        savedFileCountPDF = savedFileCountPDF + 1
                    End If
                Next
            End If
        Next
        MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation
End Sub

Answer 1

The Selection property of the Explorer class returns a Selection object that contains the item or items that are selected in the explorer window. In your code I've noticed the following lines of code:

For i = 1 To ActiveExplorer.Selection.Count

Set currentItem = ActiveExplorer.Selection(i)

So, if the selection is changed in Outlook between these two lines of code you may get out of range exception at runtime. Instead, I'd recommend caching the selection object and use it through the code to make sure it remains the same:

Set myOlExp = Application.ActiveExplorer 
Set myOlSel = myOlExp.Selection 
 
For x = 1 To myOlSel.Count  
 If myOlSel.Item(x).Class = OlObjectClass.olMail Then 
 ' do something here
 End If
Next 

Another important thing is that a folder may contain different types of items. You'd need to check their message class to distinguish different kind of Outlook items.