CODEWITHSUNDEEP
vbaoutlook
J.Zil
J.Zil

Reputation: 2449

Administrator Limited Number of Outlook Items

How to change the loop?

I really need help. I have a macro to download PDFs from messages with the following code:

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

I have a large number, around 4k. It only lets me do a few and then gives me this message in the title. Is there a way to change my code to tackle them in groups or one by one, rather than all at once?

enter image description here

Upvotes: 1

Views: 198

Answers (1)

niton
niton

Reputation: 9179

First try For Next to see if objects are released automatically.

If not successful, check if setting the object to nothing has an impact.

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

Upvotes: 2

Related Questions