Macro to automatically save email attachments

I need someway to automatically save a copy of email attachments to a windows folder.

I am working on VBA automation project that takes raw data contained in CSV files and, using Excel processes the data into a report format.
I recieve the CSV files as email attachments.
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Hi, afcnoc.

The code below will handle this.  To use this

1.  Add the code to Outlook (be sure to pay attention to the comments in the code)
2.  Create a rule that fires for the messages with the .csv attachments
3.  Set the rule's action to "run a script"
4.  Set this script as the one to run
Sub SaveCSVToDisk(Item As Outlook.MailItem)
    Dim olkFile As Outlook.Attachment
    For Each olkFile In Item.Attachments
        'Change the file name on the following line'
        If Right(LCase(olkFile.FileName, 3)) = "csv" Then
            'Change the path the file will be saved to on the following line'
            olkFile.SaveAsFile "C:\" & olkFile.FileName
        End If
    Set olkFile = Nothing
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Magnus BIT-supportCommented:
I found this script. Follow the below description
1. Start Outlook
2. Press ALT+F11 to go into VB editor
3. Rightclick Project1 and choose Insert > Module
4. Click Module1
5. Paste in this code below
6. Change the row Const BASE_PATH = "H:\\MailAttachments\\" to where you wanna save the attachments. Make sure you created the folder it points to.
7. Click Save button
8. Create a rule in Outlook that uses script (this script will now be available in the list)
hope this helps

Sub StripAttachments(Item As Outlook.MailItem)
On Error GoTo EarlyBath
Const BASE_PATH = "H:\\MailAttachments\\"
If Item.Class = olMail Then
    If Item.Attachments.Count > 0 Then
        Dim objAtt As Outlook.Attachments
        Set objAtt = Item.Attachments
        For Each objattach In objAtt
            Dim i, lngCounter As Long
            Dim strLogger, strFile, strLocalFileLink, strLocalPath, strUser, strFolder As String
            lngCounter = Item.Attachments.Count
            'Debug.Print lngcounter
            strLogger = "-------------------------------------------------------------------------------------------------"
            'organise folders by sender
            strFolder = BASE_PATH & Item.SenderName & "\\"
            If Dir(strFolder, vbDirectory) = "" Then
                MkDir (strFolder)
            End If
            'organise subfolder by received date
            strFolder = strFolder & Strings.Format(Item.ReceivedTime, "ddmmyyyy") & "\\"
            If Dir(strFolder, vbDirectory) = "" Then
                MkDir (strFolder)
            End If
            'create and display link to dest folder
            strLocalPath = "file://" & Replace(strFolder, " ", "%20")
            strLocalPath = Replace(strLocalPath, "\\", "\")
            strLogger = strLogger & vbCrLf & "Attachment Path: " & strLocalPath & vbCrLf
            strLogger = strLogger & vbCrLf & "The following attachments have been stripped from this message:"
            'move through the attachments, saving the file, deleting from msg body and inserting links
            For i = lngCounter To 1 Step -1
                strFile = objAtt.Item(i).FileName
                If Len(strFile) > 0 Then
                    Dim trimLen: trimLen = Len(strFile) - InStrRev(strFile, ".")
                    Dim time As String
                    time = Format(Now(), "hhmm")
                    strFile = strFolder & "\\" & time & "_" & strFile
                    objAtt.Item(i).SaveAsFile strFile
                    strLocalFileLink = Replace(strFile, "\\", "\")
                    strLocalFileLink = "file://" & Replace(strLocalFileLink, " ", "%20")
                    strLogger = strLogger & vbCrLf & vbCrLf & "Attachment " & lngCounter & ": " & strLocalFileLink
                End If
                    'strLogger = ""
            Next i
            strLogger = strLogger & vbCrLf & "-------------------------------------------------------------------------------------------------" & vbCrLf
            Item.Body = strLogger & Item.Body
            Set objAtt = Nothing
    End If
End If
Exit Sub
End Sub

Open in new window

afcnocAuthor Commented:

I tried you script but it doesn't seem to work. In fact, it doesn't even show in the run macro list. (But a test sub I entered does).

I created a new mod and pasted your sub into it.
Then I created a msg rule based on a subject line keyword (savetest)
set to run your script. I sent my self a msg with savetest in the subject and a small csv file attached but the attachment doesn't get saved.

Another thing I noticed is that when creating my rule, only your sub shows in the script list but not my test sub.  Any ideas?
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Macroes which include parameters to be passed, i.e. starts off with "sub macroname (parameter as type)", will not show in the list of macros.  This is the type of macro you need when associating the script with a rule - so you can pass the mailitem being used, which is what you apparently want in this instance.

Have you enabled macros in your security settings in Outlook?  If you have not, then you will be able to create the rule, and associate the macro, but it won't run.

What did you change H:\\MailAttachments to?
afcnocAuthor Commented:
Macros are enabled.
There is no  H:\\MailAttachments in BlueDevilFan's macro.
That one shows as "C:\" which I changed to "C:\emailtest".
Does it need the double back slash?
afcnocAuthor Commented:
I changed the "C:\ " to C:\\
Now I get a error "Compile error: Wrong number of arguments or invalid property assignment.

The macro stops and the LCase is highlighted.
afcnocAuthor Commented:
I just tried it as "C:\\emailtest\\" but still get the same error.
afcnocAuthor Commented:
  I also tried your, which works but gives a popup box before being able to complete.
The box states:
  A program is trying to access e-mail addresses you have stored in Outlook.
Do you want to allow this?

Clicking the yes button will allow the macro to complete and the attachment to be saved. It also writes the info into the email about the attachment being stripped and saved.
I need this to be long term automatic and work fully unattended.
Anyone have any ideas on how to keep it from promptinfo for this permission?
David LeeCommented:
"I tried you script but it doesn't seem to work. In fact, it doesn't even show in the run macro list. (But a test sub I entered does)."
That's to be expected.  The script is only desined to be run from a rule.  It wouldn't show up in the list of available macros when trying to run a macro via Tools > Macro > Macros.

"Another thing I noticed is that when creating my rule, only your sub shows in the script list but not my test sub."
That 's to be expected to.  Only macros declared to accept a parameter, i.e. Item As Outlook.MailItem, will appear in the list of available macros when selecting  amcro to run from a rule.

"but the attachment doesn't get saved."
First we need to run a test to see if the macro is failing to fire.  To do that, add this line of code between lines 7 and 8 of the original code:

    MsgBox "Rule fired"

Now, try your test again and let me know what happens.
Magnus BIT-supportCommented:
Hi again afcnoc,
The message you get is due to a Microsoft security patch and can be disabled by 3rd party software. Most scripts in Outlook will make this message to come up. I use this script at work and it works good, but yes I had to install a software to disable the security message.
Magnus BIT-supportCommented:
Try the Advanced Security for Outlook from MapiLab.
afcnocAuthor Commented:
The script is running but I get an error on line 5 at the LCase statement
"Wrong number of arguments or invalid property assignment"
The comment above this line mentions changing the file name.
Do you mean the "csv" before the then statement?
afcnocAuthor Commented:
  This is going to run on several computers throughout a large corporation.
I am pretty sure our IT dept will not be pleased with us adding any security anything to the Outlook client.
But I will ask them.
David LeeCommented:
The error is my fault.  It's a typo.  Change line #3 to
If Right(LCase(olkFile.FileName),3) = "csv" Then

Open in new window

afcnocAuthor Commented:
Tried it.
Got this error in the Watches window
Watch :   :         Right(LCase(olkFile.FileName, 3)) : <Wrong number of arguments or invalid property assignment> : Empty : Module1.SaveCSVToDisk
You left out the closing parentheses after olkFileName.
Oh, and you added it after the 3.

You are making the filename lowercase for purposes of comparison.

Then you are comparing just the last 3 characters of that to see if it is a csv file
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.