OutLook VBA 电子邮件或通知导致越界错误

Question

我有一些 Outlook VBA 代码可以很好地保存附件，但是每次我在 Outlook 中收到电子邮件或会议通知时，它都会导致即时 Out of Bounds 错误如果我没有收到任何电子邮件或通知代码都将正常运行直至完成。

有没有办法确保这些通知不会阻止代码运行？

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

这是我试图从下面的答案中创建的：

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

Explorer 类的Selection 属性返回一个Selection 对象，该对象包含在资源管理器窗口中选择的一个或多个项目。在您的代码中，我注意到以下代码行：

For i = 1 To ActiveExplorer.Selection.Count

Set currentItem = ActiveExplorer.Selection(i)

因此，如果在 Outlook 中这两行代码之间的选择发生更改，您可能会在运行时出现超出范围的异常。相反，我建议缓存选择对象并通过代码使用它以确保它保持不变：

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 

另一个重要的事情是一个文件夹可能包含不同类型的项目。您需要检查他们的邮件类别以区分不同类型的 Outlook 项目。