asked on

saving attachments in bulk

I need help debugging some code. I've been using the following code (kindly provided by BlueDevilFan) a while back

The way it works (or should work) is:
1) highlight all emails in inbox
2) when the macro runs, it will search for e-mails with attachments
3) it will then search the body of the e-mail for any lines beginning with an asterisk (*) These are the filenames to save each attachment as.
4) It will recursively save each attachment with however many filenames are provided in the body of the e-mail.

The problem is, lately we have been recieving a lot of attachments with the same filename. Say I highlight 600 e-mail messages, all with attachments. Around 100 of those will have the same attachment filename. (MyFile001.pdf), although the filenames provided in the body of the e-mail for each attachment is different.

After processing around 30 or so of these e-mails with the same attachment name, the macro poops out with the following error message:

Cannot save the attachment. Can't create file: MyFile001.PDF. Right-click the folder you want to create the file in, and then click Properties on the shortcut menu to check your permissions for the folder.

Sub SaveAttachments()
    Dim olkSelectedItems As Object, _
        olkItem As Object, _
        objFile As Object, _
        objDict As Object, _
        strFilename As String, _
        arrLines As Variant, _
        varName As Variant, _
        varTemp As Variant
    strFilename = ""
    Set olkSelectedItems = Application.ActiveExplorer.Selection
    For Each olkItem In olkSelectedItems
        Set objDict = CreateObject("Scripting.Dictionary")
        If olkItem.Attachments.Count > 0 Then
            arrLines = Split(olkItem.Body, vbCrLf)
            For Each varName In arrLines
                varTemp = Trim(varName)
                If Left(varTemp, 1) = "*" Then
                    If Not objDict.Exists(varTemp) Then
                        objDict.Add Mid(varTemp, 2), Mid(varTemp, 2)
                    End If
                End If
            Next
            arrLines = objDict.Items()
            For Each objFile In olkItem.Attachments
                For Each varName In arrLines
                    strFilename = "c:\OutlookTemp\" & varName
                    objFile.SaveAsFile strFilename
                Next
            Next
        End If
    Next
    Set objDict = Nothing
    Set objFile = Nothing
    Set olkItem = Nothing
    Set olkSelectedItems = Nothing
End Sub

Open in new window

Chris Bottomley

I use a feature to append an incremental suffix to file names so I have all versions visible. To avoid fiddling too much with what works ... try adding a function as below and replacing:

objFile.SaveAsFile strFilename
redo as
objFile.SaveAsFile getfilename(strFilename)

Chris

Function getfilename(filePathandName As String) As String
Dim filepart As String
Dim affix As String
Dim ver As Integer
 
    filepart = left(filePathandName, InStrRev(filePathandName, ".") - 1)
    affix = Right(filePathandName, Len(filePathandName) - InStrRev(filePathandName, "."))
    ver = 1
    getfilename = filepart & "_" & ver & "." & affix
    Do While DIR(getfilename) <> ""
        ver = ver + 1
        getfilename = filepart & "_" & ver & "." & affix
    Loop
    
End Function

Open in new window

NO_CARRIER

ASKER

chris, that's a great function... it solves another problem that I never thought about, overwriting the attachments.

however, the original problem still persists... it's not with the filenames used to save the files, it's with the same filenames for attachments with multiple emails, seems like it's mucking up the array somehow?

Chris Bottomley

Cant say I follow:

the array is reset for each email therefore should not have a problem with the same attachment name in another email ... the only issue I could see would be with overwriting files which was why I suggested the function.

However I guess it didn't help so any more advice on the problem ... and maybe a few representative files which demonstrate the problem would help.

Chris

NO_CARRIER

ASKER

Chris, sorry it's confusing I know. I initially thought the same thing, that it must be trying to save the files with the same filenames. But instead it seems like the input filename. (the attachment file name) is the same, in a series of e-mails.

So one e-mail may have:
Attachment: MyFile1.tif

Body: *SaveFilename1.tif
*SaveFilename2.tif

And another e-mail will have:
Attachment: MyFile1.tif

Body: *SecondEmail1.tif
*SecondEmail2.tif

For some reason, when the macro has to deal with over 40 e-mails with the same attachment filename, it stops with the error I pasted above.

Chris Bottomley

Sorry to be obtuse but the line:
"Set objDict = CreateObject("Scripting.Dictionary")"
causes the record of files saved to be reset for each email therefore the script as such is unlikely to be the issue. When it fails is the email itself 'dodgy' i.e. are there any emails with the same filename in the body text?

The bottom line being of course does it fail the same if you add the routine I suggested? If it still fails then really to help I could best use some sanitised emails that demonstarte the issue ... I can copy several forms of the same email in a dummy directory for test purposes as long as it will reproduce the failure on your system.

Chris

NO_CARRIER

ASKER

I figured just as much.

What I know is this:
When I run the macro on around 800 e-mails, around 50 of them have the same MyFile.pdf attachment. The other 750 emails have unique filenames.

When the macro fails, it always does so on an email with MyFile.pdf as the attachment. If I remove that email (put it in another folder), the macro will continue until it hits another MyFile.pdf attachment.

I added some debugging to the immediate window, in total there are 57 emails with MyFile.pdf as the attachment. If I catch the error and resume next, it stops 17 times before it finishes going though all the e-mails.

Unfortunately I can't send the actual e-mail messages I'm using, since they all contain confidential client data. :/

NO_CARRIER

ASKER

New stats for this week's e-mails:

639 e-mails selected
128 e-mails with MyFile001.PDF as the attachment.
43 attachments (MyFile001.PDF) not saved. (errors)
85 e-mails with MyFile001.PDF attachment saved successfully.

* all errors were only on e-mails where MyFile001.PDF is the attachment. If I isolate this emails (not modifying anything) and run the macro on them separately, they run successfully. Same if I split the 639 emails and run the first half, then the second half. No problems.

Chris Bottomley

Understand about the confidentiality ... ho hum.

So there are 57 emails file 'MyFile.pdf ' as a physical attachment. 17 of these emails fail and the rest work ok?

Question has to be is it something in those specific emails with the PDF's. Try moving those files to another folder and replace with copies of some remaining emails with myfile.pdf, (mark them somehow to simplify deletion afterwards).

You should now have 57 or more files again with myfile.pdf ... does it still fall over?

Alternatively, copy one file to a new directory and clone it umpteen times ... does it work? Add one file that previously failed, does it fail again .... and delete one good file does it work now?

You have presumably sussed rather than suspet David's code as faulty I suspect a dta issue with your files .... and one way or another we will find a route that works for you.

Chris

Chris Bottomley

Ah ... you're ahead of me ... sorry!

Let me think a while as this is most unexpected!

Chris

Chris Bottomley

Try a couple of 'sillies' based on teh fact that although I trust David's code ... there has to be something happening!

1. force the dictionary to nothing each time.
2. Cycle threough the items in the collection rather than the members of the collection ... some VBA collections are flawed.

Chris

Sub SaveAttachments()
    Dim olkSelectedItems As Object, _
        olkItem As Object, _
        objFile As Object, _
        objDict As Object, _
        strFilename As String, _
        arrLines As Variant, _
        varName As Variant, _
        varTemp As Variant, _
        itemCount a long
    strFilename = ""
    Set olkSelectedItems = Application.ActiveExplorer.Selection
    For itemcount = 1 to  In olkSelectedItems.count
        olkitem = olkselecteditems.item(itemcount)
        Set objDict = CreateObject("Scripting.Dictionary")
        If olkItem.Attachments.Count > 0 Then
            arrLines = Split(olkItem.Body, vbCrLf)
            For Each varName In arrLines
                varTemp = Trim(varName)
                If Left(varTemp, 1) = "*" Then
                    If Not objDict.Exists(varTemp) Then
                        objDict.Add Mid(varTemp, 2), Mid(varTemp, 2)
                    End If
                End If
            Next
            arrLines = objDict.Items()
            For Each objFile In olkItem.Attachments
                For Each varName In arrLines
                    strFilename = "c:\OutlookTemp\" & varName
                    objFile.SaveAsFile strFilename
                Next
            Next
        End If
        Set objDict = Nothing
    Next
    Set objDict = Nothing
    Set objFile = Nothing
    Set olkItem = Nothing
    Set olkSelectedItems = Nothing
End Sub

Open in new window

NO_CARRIER

ASKER

unfortunately the same problem persists. It really does not many any sense...
I'm thinking if I should just have the the user only run the macro on a smaller set of emails at a time, instead of all of them at once, once a week.

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

NO_CARRIER

ASKER

Hi Chris, unfortunately the same problem. I have no idea why this is happening, but it seems with selections of more than 500 emails this will always happen... I've told the user to only select 500 at a time. Or perhaps I should just make it select 500 emails at a time, loop through, then select the next 500, loop, etc.

Chris Bottomley

The previous post does batch them in sets of 50 so in theory is in tune with your thought, (Or perhaps I should just make it select 500 emails at a time, loop through, then select the next 500, loop, etc).

There are no global nor static variables at play here so there is no logic for the issue so without being able to reproduce the situation I am at a loss.

Chris

NO_CARRIER

ASKER

Hey Chris,

I just wanted to say thanks for all your input on this problem.
The problem still exists, and has replicated on each user's PC too. Still no idea why.
But I told them to run the batch process daily instead. (before the number of emails reaches 500) which seems to be working for now.

I am still curious as to why this is happening, but for now... at least there's a workaround.

Thanks again,

+++ath0
NO CARRIER