Save outlook attachments

Exporting your attachments from your outlook to a folder

1) Make sure you have the proper folders, go into your local drive C:

2) Go into Users

3) Go into your currently logged in Profile (This computer account is lfsuser)

4) Go into Documents

5) There should be an Attachments folder here, this is where the email attachments are saved to. If there is no Attachments folder, create a folder with the name Attachments

6) Now open outlook and click on the Developer tab and click on Visual Basics, if this tab doesn't exist follow the next few steps, otherwise skip to step 10

7) Click on File

8) Go to Options

9) Go to Customize Ribbons and make sure the Developer box is checked

10) Now exit and go back and click on Developer and then Visual Basics

11) Click on Insert and then Module

12) Copy the following code into the box, it should look something like this

Public Sub SaveAttachments()
Dim objOL As Outlook.Application 
Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim objSelection As Outlook.Selection 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
strFolderpath = strFolderpath & "\Attachments\"
For Each objMsg In objSelection
   Set objAttachments = objMsg.Attachments
   lngCount = objAttachments.Count
   strDeletedFiles = ""
   If lngCount > 0 Then
       For i = lngCount To 1 Step -1
           strFile = objAttachments.Item(i).FileName
           strFile = strFolderpath & strFile
           objAttachments.Item(i).SaveAsFile strFile
           If objMsg.BodyFormat <> olFormatHTML Then
               strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
           Else
               strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
               strFile & "'>" & strFile & "</a>"
           End If
       Next i
       If objMsg.BodyFormat <> olFormatHTML Then
           objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
       Else
           objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
       End If
       objMsg.Save
   End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

13) Now Go to File and then Save and exit

14) To export the attachments, select the emails that you want to export the attachments (CTRL+A to select all), and then click Developer then Macros then Save.Attachments

15) Your files will be saved to the Attachments folder

Source: http://stackoverflow.com/questions/15531093/save-attachments-to-a-folder-and-rename-them