VBA to save mail attachments in specific folder

[Hermanie]

Hi all,

I'm looking for a simple VBA code. Everyday I receive an email with an attachment, which I want to save in a specific folder on the hard drive. I've set up a rule to place the email in a specific outlook folder. This way the only thing to happen is to save the attachments of every new received email in a specific folder, like C:\test.

I've found the following page Save E-mail attachments to folder, with the following code:

[COLOR=#3366CC]Sub Test()[/COLOR][COLOR=black]'Arg 1 = Folder name of folder inside your Inbox
'Arg 2 = File extension, "" is every file
'Arg 3 = Save folder, "C:\Users\Ron\test" or ""
'        If you use "" it will create a date/time stamped folder for you in your "Documents" folder
'        Note: If you use this "C:\Users\Ron\test" the folder must exist.[/COLOR]

    SaveEmailAttachmentsToFolder "MyFolder", "xls", ""
     [COLOR=#3366CC]End Sub[/COLOR]

But this doesn't seem to work, as 'SaveEmailAttachmentsToFolder isn't defined.

 

[jorismoerings]

Hi,

Did you copy the complete function? Or just the first rows you've read?
It seems to me that you missed this important part of the explanation of Ron because i see only 1 part in your question
1) Go to the VBA editor, Alt -F11
2) Tools>References in the Menu bar
3) Place a Checkmark before Microsoft Outlook ? Object Library
? is the Outlook version number
4) Insert>Module
5) Paste the code (two macros) in this module
6) Alt q to close the editor
7) Save the file


But this is a VBA script you can run from an Excel workbook, if you want it to run with a Rule within Outlook than don't use the Excel VBA but use a Outlook VBA scipt and combine it with the rule you're using.
Your outlook script could look like this:

Public Sub SaveAttachments(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then
 
Dim EmAttach As Outlook.Attachments
Dim AttachCount As Long
Dim EmAttFile As String
Dim sFileType As String
Dim i As Long

Set EmAttach = Item.Attachments
    AttachCount = EmAttach.Count
 For i = AttachCount To 1 Step -1

' Get the file name.
 EmAttFile = EmAttach.Item(i).FileName
 
 If LCase(Right(EmAttFile, 5)) = ".xlsx" Then

        ' Get the path to your My Documents folder
        DestFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
        DestFolderPath = DestFolderPath & "\Attachments\"
        
        ' Combine with the path to the folder.
        EmAttFile = DestFolderPath & EmAttFile
        
        ' Save the attachment as a file.
        EmAttach.Item(i).SaveAsFile EmAttFile
    End If
 Next i
End If

End Sub

and the steps to get there:
1) Open Outlook
2) Go to the VBA editor, Alt -F11
3) Insert>Module
4) Paste the code in this module
5) Alt q to close the editor
6) Create an Outlook message rule to run a scipt on arrival

Hope this helps.

 

[Hermanie]

Thanks! Works perfectly

 

[knowledge]

Hi,

Did you copy the complete function? Or just the first rows you've read?
It seems to me that you missed this important part of the explanation of Ron because i see only 1 part in your question
1) Go to the VBA editor, Alt -F11
2) Tools>References in the Menu bar
3) Place a Checkmark before Microsoft Outlook ? Object Library
? is the Outlook version number
4) Insert>Module
5) Paste the code (two macros) in this module
6) Alt q to close the editor
7) Save the file


But this is a VBA script you can run from an Excel workbook, if you want it to run with a Rule within Outlook than don't use the Excel VBA but use a Outlook VBA scipt and combine it with the rule you're using.
Your outlook script could look like this:

Public Sub SaveAttachments(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then
 
Dim EmAttach As Outlook.Attachments
Dim AttachCount As Long
Dim EmAttFile As String
Dim sFileType As String
Dim i As Long

Set EmAttach = Item.Attachments
    AttachCount = EmAttach.Count
 For i = AttachCount To 1 Step -1

' Get the file name.
 EmAttFile = EmAttach.Item(i).FileName
 
 If LCase(Right(EmAttFile, 5)) = ".xlsx" Then

        ' Get the path to your My Documents folder
        DestFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
        DestFolderPath = DestFolderPath & "\Attachments\"
        
        ' Combine with the path to the folder.
        EmAttFile = DestFolderPath & EmAttFile
        
        ' Save the attachment as a file.
        EmAttach.Item(i).SaveAsFile EmAttFile
    End If
 Next i
End If

End Sub

and the steps to get there:
1) Open Outlook
2) Go to the VBA editor, Alt -F11
3) Insert>Module
4) Paste the code in this module
5) Alt q to close the editor
6) Create an Outlook message rule to run a scipt on arrival

Hope this helps.

Hi I tried the above code comes with the error message "cannot save the attachment.Path does not exist.Verify the path is correct"
i am trying to save the attachment from my email to mydocuments folder .

Thanks

 

[knowledge]

Hi Mate ,
Its working now , earlier Attachment folder was missing under Mydocuments.

Thanks alot for your code .

 

[knowledge]

its working now . Thanks a lot

 

[maxon]

Is it possible to set saving attachements from e-mail without using script in outlook as I have blocked this option in my Outlook.

 

[jay140261]

Hi, I am just starting out and since you have managed to get the gist of it, request that you post the full code,. In my case I have emails coming from one sender which contain Stock quotes both in rar formats as well as csv formats. I need to save both these and then download them to a program called Amibroker which is a charting software. I have now tried various scripts posted in this connection but have not been able to get ahead. I have a Gmail account which is being downloaded into Outlook, and I have set labels so that the mail goes into a folder called John. I have a folder on my C drive as John, C:/John and with a subfolder for attachments called Attachments. My windows is on Parallel Desktop on a Mac machine. Thanks and hope to hear from you.

 

[Hermanie]

Hi Jay,

Please find the code attached, this might help on savings each attachment in the folder. You which to specify the type of file or name of the attachment, the coding should be added to the loop trough each OlItem.

'*************************************************'Requires Reference to Microsoft Outlook library
'*************************************************
Public Sub saveMails()


Dim OlApp As New Outlook.Application
Dim OlMail As Outlook.MailItem
Dim OlItems As Outlook.Items
Dim OlFolder As Outlook.MAPIFolder
Dim olns As Outlook.Namespace
Dim I As Integer
Dim strFolder As String
Dim mySaveName As String




    strFolder = "C:\Test" 'Save locatie
    
    On Error Resume Next
    
    Set OlApp = GetObject(, "Outlook.Application")
    Set olns = OlApp.GetNamespace("MAPI")
    
    If Err.Number = 429 Then
        Set OlApp = CreateObject("Outlook.application")
    End If
    
    Set OlFldr = olns.Folders("name_mailbox@mail.com") 'name of the mailbox as found in Outlook, via aco**** settings
    
    Set OlFldr = OlFldr.Folders.Item("Inbox") 'set folder to look for email
    Set OlFldr = OlFldr.Folders("Folder 1") 'set next folder to look for email, this folder is in the first folder
    Set OlFldr = OlFldr.Folders("Folder 2") 'next folder, etcetera


    If OlFldr Is Nothing Then 'Check if OlFldr is found
        MsgBox "Folder not found"
        GoTo Ready
    End If
    
    Set OlItems = OlFldr.Items 'Declare mails as items
    OlItems.Sort "[ReceivedTime]", True 'Sort mail from new to old
    
    For Each OlMail In OlItems     'Loop through all emails
        If OlMail.Attachments.Count > 0 Then 'check for attachments
            For I = 1 To OlMail.Attachments.Count 'loop through all attachments
                OlMail.Attachments.Item(I).SaveAsFile mySaveName 'Save each attachment in the specified location
            Next
        End If
    Next
    
Ready:
    'clean up
    Set OlFolder = Nothing
    Set OlItems = Nothing
    Set OlMail = Nothing
    Set OlApp = Nothing


End Sub