管理员限制的Outlook项目数

Question

如何更改循环？

我真的需要帮助。我有一个宏，可以使用以下代码从邮件中下载PDF：

Sub SaveAttachmentsFromSelectedItemsPDF2()

    Dim currentItem As Object
    Dim currentAttachment As Attachment
    Dim saveToFolder As String
    Dim savedFileCountPDF As Long

    saveToFolder = "c:\dev\pdf" 'change the path accordingly

    savedFileCountPDF = 0
    For Each currentItem In Application.ActiveExplorer.Selection
        For Each currentAttachment In currentItem.Attachments
            If UCase(Right(currentAttachment.DisplayName, 4)) = ".PDF" Then
                currentAttachment.SaveAsFile saveToFolder & "\" & _
                    Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".pdf"
                savedFileCountPDF = savedFileCountPDF + 1
            End If
        Next currentAttachment
    Next currentItem

    MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation

End Sub

我有很多，大约4k。它只允许我执行一些操作，然后在标题中提供此消息。有没有一种方法可以更改我的代码，以成组地或一次而不是一次全部解决它们？

Answer 1

首先尝试“下一步”以查看对象是否自动释放。

如果未成功，请检查将对象设置为空是否有影响。

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\pdf" '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, 4)) = UCase(".PDF") Then
                currentAttachment.SaveAsFile saveToFolder & "\" & _
                  Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".pdf"
                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