Need to move attachments from outlook folder to Windows folder

Hi Experts,

Need help .

I have one folder in outlook where rule is created to get emails that have attachments , I need to save all email attachment comes in that outlook folder to my windows folder , Appreciate your help in advance.

I don't know how to create macros and execute as well.
Afzal KhanSoftware ProfessionalAsked:
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.

Andrew LeniartSenior EditorCommented:
Firstly, don't export attachments to your "Windows" folder as that's a system folder and shouldn't have folders added to it manually. Rather, create a folder for the purpose under your C:\ drive or preferably, in your Documents folder.

Second, how many messages are we talking about here that contain attachments? If there aren't that many, it's easy to do by just opening the message, right-clicking on the attachment and selecting Save As and then save the attachment to the folder you've created. A good explanation of the process can be viewed here: https://support.office.com/en-us/article/open-or-save-attachments-92f87f3f-1085-425a-87f6-08d43c19b43d

If you're talking about a lot of emails, then you can create and use a rule in Outlook to accomplish that as well. Here's a link that shows how to do it with pictures: http://www.res-q.com.au/news/quickly-saveexport-attachments-multiple-emails-outlook

Here's a means to do it with a pre-written macro for you, with instructions on how to install and use it. https://thetechieguy.com/extracting-all-attachments-from-outlook-to-your-computer-not-one-by-one/ DISCLAIMER: I have not tried this solution so try at own risk.

Plenty of commercial solutions available to do this (and more) too if you don't mind buying a solution. Just google a search term like: bulk save email attachments outlook

Let me know if you need further help.

Regards, Andrew
0
Afzal KhanSoftware ProfessionalAuthor Commented:
Thanks Andrew.

The pre-written  macro worked .

1- But my requirement is to run directly a Rule folder not a select prompt.
2- Need to save attachments excluding signature images.


Please help
0
Andrew LeniartSenior EditorCommented:
AFzal,

Glad it worked for you.

Should be able to create a rule that will do that - what version of Outlook are we dealing with here?

Also, what do you mean by "Excluding Signature Images" ?  Please elaborate or upload a screenshot that will show what you mean.

Cheers...

Andrew
0
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.

Afzal KhanSoftware ProfessionalAuthor Commented:
Hi Andrew,

I am using Outlook 2010.

Excluding signature images means it is downloading all the attachments including the images in email signatures like company logo etc.

in below article it is mentioned how to exclude signature images but I  don't know how to modify your script accordingly.

https://www.slipstick.com/developer/save-attachments-to-the-hard-drive/ 

Also it is asking to select folder at prompt , is there any way we can just by default select  any subfolder on which rule is setup?

Thanks in advance !!!
0
Andrew LeniartSenior EditorCommented:
Ahh ok. That would mean modifying the Script/Macro to suit your purposes. I'm afraid I'm not able to help with that.

I'd suggest closing this question and opening another question pertaining to the issue at hand now.

Ie: How to modify the macro content.

Suggest naming the new question with something like: Help to modify an Outlook 10 Macro

and use Topics "Microsoft Office" "Outlook" "Scripting Languages"

That should attract more appropriate experts who will be able to help with Modifying the Macro you are using.

I hope that's helpful.

Regards, Andrew
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You can tweak the code like this...

Note: Pay attention to the lines#16-20

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
Dim subFolderName As String
Dim sFileType As String
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    'Assuming you have a folder called "Email Attachments" in your Document folder
    
    subFolderName = "Email Attachments"
    
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\" & subFolderName & "\"
    
    If Len(Dir(strFolderpath, vbDirectory)) = 0 Then
        MsgBox "The folder " & subFolderName & " was not found in the Documetn Folder.", vbExclamation, "Cannot Contiue!"
        Exit Sub
    End If
    
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = New Outlook.Application
    
    
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

    ' Check each selected item for attachments.
    For Each objMsg In objSelection
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
            
        If lngCount > 0 Then
        
           ' Use a count down loop for removing items
           ' from a collection. Otherwise, the loop counter gets
           ' confused and only every other item is removed.
           
           For i = lngCount To 1 Step -1
            
               ' Get the file name.
               strFile = objAttachments.Item(i).Filename
                
               ' This code looks at the last 4 characters in a filename
                 sFileType = LCase$(Right$(strFile, 4))
            
                 Select Case sFileType
               ' Add additional file types below
                  Case ".jpg", ".png", ".gif"
                   If objAttachments.Item(i).Size < 5200 Then
                       GoTo nexti
                   End If
                 End Select
              
               ' Combine with the path to the Temp folder.
               strFile = strFolderpath & strFile
                
               ' Save the attachment as a file.
               objAttachments.Item(i).SaveAsFile strFile
           
nexti:
           Next i
        End If
    Next objMsg
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Open in new window

0
Afzal KhanSoftware ProfessionalAuthor Commented:
Thanks Neeraj , but I need to move attachments from Outlook folder "X" (rule is set on this , so how to mention directly that folder?
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Where does the folder "X" exist? Is it a subfolder of Inbox or any other default folder or independent folder outside the default folders?
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please tweak the following code as per your requirement.

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim NS As Outlook.Namespace
Dim srcOLFolder As Outlook.Folder
Dim i As Long
Dim lngCount As Long
Dim srcOLFolderName As String
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim subFolderName As String
Dim sFileType As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    'Assuming you have a folder called "Email Attachments" in your Document folder
    
    subFolderName = "Email Attachments"
    
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\" & subFolderName & "\"
    
    If Len(Dir(strFolderpath, vbDirectory)) = 0 Then
        MsgBox "The folder " & subFolderName & " was not found in the Documetn Folder.", vbExclamation, "Cannot Contiue!"
        Exit Sub
    End If
    
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = New Outlook.Application
    
    'Assuming the Source Outlook Folder's name is "X" and it is a Sub-Folder of INBOX.
    srcOLFolderName = "X"   'Change the Sub-Folder's name here if required
    
    Set NS = objOL.GetNamespace("MAPI")
    Set srcOLFolder = NS.GetDefaultFolder(olFolderInbox).Folders(srcOLFolderName)
    
    
        ' Looping through each item in the Source Outlook Folder
    For Each objMsg In srcOLFolder.Items
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
            
        If lngCount > 0 Then
        
           ' Use a count down loop for removing items
           ' from a collection. Otherwise, the loop counter gets
           ' confused and only every other item is removed.
           
           For i = lngCount To 1 Step -1
            
               ' Get the file name.
               strFile = objAttachments.Item(i).Filename
                
               ' This code looks at the last 4 characters in a filename
                 sFileType = LCase$(Right$(strFile, 4))
            
                 Select Case sFileType
               ' Add additional file types below
                  Case ".jpg", ".png", ".gif"
                   If objAttachments.Item(i).Size < 5200 Then
                       GoTo nexti
                   End If
                 End Select
              
               ' Combine with the path to the Temp folder.
               strFile = strFolderpath & strFile
                
               ' Save the attachment as a file.
               objAttachments.Item(i).SaveAsFile strFile
           
nexti:
           Next i
        End If
    Next objMsg
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set srcOLFolder = Nothing
Set objOL = Nothing
End Sub

Open in new window

0
Afzal KhanSoftware ProfessionalAuthor Commented:
Folder "X" is independent folder
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Then try this...

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim NS As Outlook.Namespace
Dim srcOLFolder As Outlook.Folder
Dim i As Long
Dim lngCount As Long
Dim srcOLFolderName As String
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim subFolderName As String
Dim sFileType As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    'Assuming you have a folder called "Email Attachments" in your Document folder
    
    subFolderName = "Email Attachments"
    
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\" & subFolderName & "\"
    
    If Len(Dir(strFolderpath, vbDirectory)) = 0 Then
        MsgBox "The folder " & subFolderName & " was not found in the Documetn Folder.", vbExclamation, "Cannot Contiue!"
        Exit Sub
    End If
    
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = New Outlook.Application
    
    'Assuming the Source Outlook Folder's name is "X" and it is a Sub-Folder of INBOX.
    srcOLFolderName = "X"   'Change the Sub-Folder's name here if required
    
    Set NS = objOL.GetNamespace("MAPI")
    Set srcOLFolder = NS.GetDefaultFolder(olFolderInbox).Parent.Folders(srcOLFolderName)
    
    
        ' Looping through each item in the Source Outlook Folder
    For Each objMsg In srcOLFolder.Items
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
            
        If lngCount > 0 Then
        
           ' Use a count down loop for removing items
           ' from a collection. Otherwise, the loop counter gets
           ' confused and only every other item is removed.
           
           For i = lngCount To 1 Step -1
            
               ' Get the file name.
               strFile = objAttachments.Item(i).Filename
                
               ' This code looks at the last 4 characters in a filename
                 sFileType = LCase$(Right$(strFile, 4))
            
                 Select Case sFileType
               ' Add additional file types below
                  Case ".jpg", ".png", ".gif"
                   If objAttachments.Item(i).Size < 5200 Then
                       GoTo nexti
                   End If
                 End Select
              
               ' Combine with the path to the Temp folder.
               strFile = strFolderpath & strFile
                
               ' Save the attachment as a file.
               objAttachments.Item(i).SaveAsFile strFile
           
nexti:
           Next i
        End If
    Next objMsg
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set srcOLFolder = Nothing
Set objOL = Nothing
End Sub

Open in new window

0

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
Afzal KhanSoftware ProfessionalAuthor Commented:
Thanks Andrew and Neeraj ji
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Afzal!

BTW what's the point in awarding 500 bonus points only?
0
Afzal KhanSoftware ProfessionalAuthor Commented:
I am new user I don't know how to award bonus
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Sorry for the typo in your name in my last reply, I have corrected it.

I am new user I don't know how to award bonus
I understand. And I don't know the exact process too as I don't ask questions.
But you might have got a slider which you could slide to award the bonus points. Right? I guess, you made some mistake in there.

Actually EE should provide a video tutorial about how to properly accept an answer and close the question.

BTW you may open a ticket by reporting the question and explaining the issue, a moderator will guide you through the proper steps to reassign bonus points correctly. Please click the link shown in the image below to report the question...

ReportQuestion.jpg
0
Afzal KhanSoftware ProfessionalAuthor Commented:
I have raised a request with moderator
0
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
Microsoft Office

From novice to tech pro — start learning today.