Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

saving attachments in bulk

Posted on 2008-09-29
15
Medium Priority
?
253 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 7
15 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22598679
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
ID: 22600050
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
ID: 22600276
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Author Comment

by:NO_CARRIER
ID: 22605220
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
ID: 22605504
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
ID: 22608768
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
ID: 22608941
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22609001
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
ID: 22609016
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
ID: 22609106
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
ID: 22678407
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 1400 total points
ID: 22681412
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
ID: 22823838
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
ID: 22824123
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
ID: 23282517
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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
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…

610 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