Solved

saving attachments in bulk

Posted on 2008-09-29
15
245 Views
Last Modified: 2012-05-05
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

0
Comment
Question by:NO_CARRIER
  • 8
  • 7
15 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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

0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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.





0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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. :/
0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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.
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Ah ... you're ahead of me ... sorry!

Let me think a while as this is most unexpected!

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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

0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 350 total points
Comment Utility
Ok Kludge time ... i.e. I cannot understand why it is an issue BUT bear with me as I am coding in teh blind

Try the following as a new module and run saveasattachments it will hopefully run the main routine in batches of 50 resulting in a clean run since the routine will be fresh ech time.

Chris
Sub SaveAttachments()

    Dim olkSelectedItems As Object

    dim itemCount as long
 

    Set olkSelectedItems = Application.ActiveExplorer.Selection

    For itemcount = 0 to (olkSelectedItems.count - 1) step 50

        saveafew itemcount

    next

end sub
 

Sub SaveaFew(starter as long)

    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 as long

    strFilename = ""

    Set olkSelectedItems = Application.ActiveExplorer.Selection

    For itemcount = starter + 1 to starter + 50

        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

0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
0
 
LVL 1

Author Comment

by:NO_CARRIER
Comment Utility
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
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now