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

Question

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

有没有办法确保这些通知不会停止来自运行ning 的代码？

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 class returns 的 Selection 属性 Selection 对象包含在探险家 window。在您的代码中，我注意到以下代码行：

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

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

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

OutLook VBA Email or Notification Causes Out of Bounds Error

outlook

vba