server item limit and garbage collection

[BrianMH]

Hi,

Is there any way to force garbage collection in vba?

I am having real trouble as I am downloading large numbers of attachments by iterating through selected mails. The server administrators have limited the numbers of items that can be open to 500. I used to get around this using cached exchange mode but this has now been disabled by our admin. I am trying to set all the objects to nothing but it still seems to fail. I even seperated the bit that does the attachments to a seperate sub hoping that losing scope would clean up the number of items open in the back ground. My code is listed below and if anyone can figure this out it would be greatly appreciated.

The error I get is
"Run-time error '-2147220731 (80040305)':
Cannot save the attachment. Your server administrator has limited the number of items you can open simultaneously. Try closing messages you have opened or removing attachments and images from unsent messages you are composing"


Option Explicit
Public AttachmentCount As Integer
Function Downloadattachments(strpath As String)

Dim myOlApp As New outlook.Application
Dim myOlExp As outlook.Explorer
Dim myOlSel As outlook.Selection
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
Dim myMitem As MailItem
Dim myPitem As PostItem
Dim myItem

AttachmentCount = 0

For Each myItem In myOlSel
Call downloadmail(myItem, strpath)
Next

MsgBox ("downloaded " & AttachmentCount & " attachments from " & myOlSel.Count & " emails")



End Function
Sub downloadmail(myMailItem, strpath As String)
Dim strFileName As String
Dim strNewName As String
Dim strPre As String
Dim strExt As String
Dim myolAttachments As Attachments
Dim myolAtt As Attachment
Dim intExtlen As Integer
Dim w As Integer
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
If myMailItem.Attachments.Count <> 0 Then
Set myolAttachments = myMailItem.Attachments
For Each myolAtt In myolAttachments
strFileName = myolAtt.DisplayName
'find out if the file exists in the download location already and if so rename
'to a filename including a number eg. file(1).xls
If fs.fileexists(strpath & "\" & strFileName) = True Then
strNewName = strFileName
'get the length of the extension including the .
intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1
'check there is actually a file extension and if not set extension to blank
'and set strPre to the full file name
If InStrRev(strFileName, ".") > 0 Then
strExt = Right(strFileName, intExtlen)
strPre = Left(strFileName, Len(strFileName) - intExtlen)
Else
strExt = ""
strPre = strFileName
End If
'increase the file number (w) until the file name no longer exists file(1).ext to file(2).ext etc
'strpre = filename before extension strext = extension w=file number
While fs.fileexists(strpath & "\" & strNewName) = True
w = w + 1
strNewName = strPre & Chr(40) & w & Chr(41) & strExt
Wend
'set the new filename
strFileName = strNewName
w = 0
End If
myolAtt.SaveAsFile strpath & "\" & strFileName
AttachmentCount = AttachmentCount + 1
Set myolAtt = Nothing
Next
End If
myMailItem.UnRead = False
Set myolAttachments = Nothing
Set myMailItem = Nothing
End Sub

[JP2112]

My understanding is that there is no way to force garbage collection in VBA.

I ran your code and it worked for me without issue, but I only had 59 attachments in 113 emails. I believe you are looping through too many items. Limit the initial collection of items to emails with attachments:

Function Downloadattachments(strpath As String)

Dim olApp As Outlook.Application
Dim expl As Outlook.Explorer
Dim currentItems As Outlook.Items
Dim itemsWithAttachments As Outlook.Items
Dim myItem As Object
Dim msg As Outlook.MailItem

' only loop through items with attachments
Set olApp = Outlook.Application
Set expl = olApp.ActiveExplorer
Set currentItems = expl.CurrentFolder.Items
Set itemsWithAttachments = currentItems.Restrict("[Attachments] > 0")

AttachmentCount = 0

For Each myItem In itemsWithAttachments
If TypeName(myItem) = "MailItem" Then
Set msg = myItem
Call downloadmail(msg, strpath)
End If
Next
MsgBox ("downloaded " & AttachmentCount & " attachments from " & itemsWithAttachments.Count & " emails")
End Function

As an added benefit, you no longer have to select the emails before running the code -- it will simply save all attachments from every message in the folder.

Also, you might want to check the type of attachment, because Outlook treats images in signatures as 'attachments'. If an email has no "real" attachments, but the sender has an image in their signature, it will be added to the filtered collection above. Note that this would make itemsWithAttachments.Count inaccurate.

[BrianMH]

Thanks for that.

I like to use selection as it enables us to choose the specific emails we want to download from, instead of moving emails to a particular folder. I know this isn't that big of a deal but it is nice and it should be feasible.

I got an error with your code on the filter so I removed your filter. However your code did allow me to fully download everything in the folder.

The strange thing is with my code using selection I hit a limit of 500 attachments. It does not matter if I have 500 attachments spread across 500 mails or 5 mails.

Your code was able to download 2000 attachments for over 500 mail items so it doesn't seem to be a matter of looping through too many items. It seems that its more to do with the fact that for some reason your code is releasing the objects and mine is not. Something to do with working with a selection I guess. I even tried Dim myItem as object in my code with no luck.

Any ideas would be helpful although I'm really thinking that this is a limitation that I can't get around working with a selection.