• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2301
  • Last Modified:

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.
0
afcnoc
Asked:
afcnoc
  • 8
  • 3
  • 3
  • +1
1 Solution
 
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
    Next
    Set olkFile = Nothing
End Sub

Open in new window

0
 
MadjaxCommented:
Hi,
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
/MadJax

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
                    objAtt.Item(i).Delete
                    strLocalFileLink = Replace(strFile, "\\", "\")
                    strLocalFileLink = "file://" & Replace(strLocalFileLink, " ", "%20")
                
                    strLogger = strLogger & vbCrLf & vbCrLf & "Attachment " & lngCounter & ": " & strLocalFileLink
                Else
                End If
                    'strLogger = ""
SkipAtt:
            Next i
            
            strLogger = strLogger & vbCrLf & "-------------------------------------------------------------------------------------------------" & vbCrLf
            
            Item.Body = strLogger & Item.Body
            Item.Save
        Next
            Set objAtt = Nothing
        
    End If
End If
EarlyBath:
Exit Sub
End Sub

Open in new window

0
 
afcnocAuthor Commented:
BlueDevilFan:

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?
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
brookslawCommented:
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?
0
 
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?
0
 
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.
0
 
afcnocAuthor Commented:
I just tried it as "C:\\emailtest\\" but still get the same error.
0
 
afcnocAuthor Commented:
Madjax:
  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?
0
 
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.
0
 
MadjaxCommented:
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.
0
 
MadjaxCommented:
Try the Advanced Security for Outlook from MapiLab.
directlink> http://www.mapilab.com/files/security_outlook.zip
0
 
afcnocAuthor Commented:
BlueDevilFan:
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?
0
 
afcnocAuthor Commented:
Madjax:
  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.
0
 
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

0
 
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
0
 
brookslawCommented:
You left out the closing parentheses after olkFileName.
0
 
brookslawCommented:
Oh, and you added it after the 3.

You are making the filename lowercase for purposes of comparison.
LCase(olkFile.Filename)

Then you are comparing just the last 3 characters of that to see if it is a csv file
Right(LCase(olkFile.FileName),3)
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

  • 8
  • 3
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now