Save Attachments to the hard drive

Last reviewed on September 6, 2013   —  74 comments

The following code works in Outlook 2000 and up. It saves the attachments from selected messages but does not delete the attachments from the message(s). This VBA code is based on the code sample at our Outlook-Tips site: Save and Delete Attachments. Use it if you want to save the attachment, add a link to the saved file, and delete the attachment from the message.

Instructions to add the macro to a toolbar button or ribbon command are at the end of the page.

Save Attachments to the hard drive

Copy and paste the code from this page into your ThisOutlookSession project.

In Outlook, press Alt+F11 to open the VBA editor and expand Microsoft Outlook Objects then double click on ThisOutlookSession to open it in the editing pane and Ctrl+V to paste the code.

To use it you must first create a folder under your My Documents named OLAttachments (the code will not create it for you). Then select one or more messages and run the macro to save the attachments. You'll need to set macro security to warn before enabling macros or sign the macro. You can change the folder name or path where the attachments are saved by editing the code.

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

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\OLAttachments\"

    ' 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
    
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
    
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
    
    Next i
    End If
    
    Next
    
ExitSub:

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

Add the message date to the filename

If you want to add the message date to the file, you'll need to get the date from the SentOn or ReceivedDate fields then format it as a string before adding it to the file name. It's a total of 4 new lines and one edited line.

First, Dim the two new variables at the top of the macro:

Dim dtDate As Date
Dim sName As String

To format the date and time and add it to the filename in 20130905045911-filename format, you'll add two lines of code after you count the attachments to get the date and format it, then edit the line that creates the filename.


    If lngCount > 0 Then

       dtDate = objMsg.SentOn

         sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-"

   For i = lngCount To 1 Step -1

    ' Get the file name.
       strFile = sName & objAttachments.Item(i).FileName

Don't save images in signatures

This macro saves all attachments, including images embedded in signatures (they are attachments after all). To avoid saving signature images, you have two options: don't save image files, or don't save smaller files. You could even do both and save only larger images files.

Replace the code between For i = lngCount To 1 Step -1 / Next i lines with the following to filter out files smaller than 5KB. This should catch most signature images (and many text files).

If the attachments you need to save are always over 5 KB, you can increase the file size. (For reference, a blank Word document is over 10KB.)

    For i = lngCount To 1 Step -1
       If objAttachments.Item(i).Size > 5200 Then

    ' Get the file name.
    strFile = objAttachments.Item(i).filename
     
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
     
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
     End If
     
    Next i

If you want to skip or save only a specific file type, use If LCase(Right(strFile, 4)) <> ".ext" format, where .ext is the extension. Add it after the first line strFile = line (and don't forget to add the End if before the Next i). You can use it to exclude a file type or use an equal (=) sign to save only a specific file type. (For 4-character extensions, use only the characters, don't include the dot.)

To work with a longer list of file types, use a Select Case statement. In this example, we're looking for image attachments, and if less than approx 5KB, we skip them. Larger image attachments will be saved.

    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

Assign the macro to a button

In Outlook 2007 and older, you can create a toolbar button to run the macro. In Outlook 2010, you'll need to customize the ribbon.

More information is at Customize the Outlook Toolbar, Ribbon or QAT and at Customizing the Quick Access Toolbar (QAT).

Run the macro using a ribbon or QAT shortcut

customize the ribbon to add a macro buttonStep 1: To create a button to run a macro in Outlook 2010, go to File, Options, and choose Customize Ribbon. (If you want a button on the QAT, choose Quick Access Toolbar instead.)

Step 2: Choose Macro from the Choose Commands From menu and select the macro you want to add to the ribbon or QAT.

Step 3: Select the Group you want to add the macro to. If it doesn't exist yet, use the New Group buttons to create the group.

Step 4: Use the Rename button to give the macro a friendly name and change the icon. You are limited to the icons in the dialog (unless you want to program a ribbon command).

Run the macro from a toolbar button

customize toolbar dialog

To create a toolbar button for it, go to View, Toolbar, Customize, Commands tab. In the Categories pane, type M to jump to Macros. On the Commands side, drag the macro you created to the toolbar. Right click on the button to rename it and assign a new icon.

About Diane Poremsky

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Please post long or more complicated questions at Outlook forums by Slipstick.com.

74 responses to “Save Attachments to the hard drive”

  1. Bertie

    Some attachments are themselves messages with further attachments - n levels deep! Can these also be saved?

    1. Diane Poremsky

      Each nested message as separate messages rather than one attachment? No, not easily. You can drag the message attachment to a folder then run the macro.

  2. donna russo

    Hi Diane,

    Do you know if there is a script to:
    1. open email (jotform)
    2. click on link in body of email--field on the jotform (which has the attachment)
    3.Save the attachment that opened when link is clicked to a folder?

    Thanks,
    Donna

    1. Diane Poremsky

      I'm not aware of any script that can do that. Sorry.

  3. Mike Kennedy

    is there a macro to access all of the attachments in a calendar?

  4. tech

    Hi Diane!

    Is it possible to access all of the RSS attachments?

    Thanks ;)
    nik

    1. Diane Poremsky

      Automatically? If the enclosures are downloaded, yes. For automatic use, you'd need to watch the folder (easiest with 1 folder or if all are delivered to 1 folder).

  5. nik

    no, just execute the macro for all unread RSS (or selected).

    > If the enclosures are downloaded
    OK. There would be no macro option (at least a manual method in Outlook settings), which automatically downloads the attachments of all RSS items?

    1. Diane Poremsky

      To the best of my knowledge, no, that is not exposed in the object model. You could use send keys to get it, but that is really messy.

  6. Andy McCarthy

    Hello Diane,

    Is it possible to modify the code so that the "save attachment" window launches during each loop? Certainly not as fast but it would give me the ability to process multiple emails and save files to various locations.

    Thanks!

    Andy

    1. Diane Poremsky

      yes, it is. I have code here somewhere for a folder picker. I'll see if i can find it.

  7. Diane Poremsky

    Use this as the folder path -
    strFolderpath = BrowseForFolder("\\")

    this as the path and file name
    strFile = strFolderpath & "\" & strFile

    and this function:

    Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    'Function To Browse for a user selected folder.
    'If the "OpenAt" path is provided, open the browser at that directory
    'NOTE: If invalid, it will open at the Desktop level
    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    'Set the folder to that selected. (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    'Destroy the Shell Application
    Set ShellApp = Nothing
    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in \\servername\sharename. All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
    GoTo Invalid
    End Select
    Exit Function
    Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
    End Function

  8. Suzanne

    For some reason, this only exports the attachment from the first email and ignores the rest.

    1. Diane Poremsky

      So it skips button multiple attachments on one message and attachments on multiple messages?

      I'd add either debug.print objMsg.subject & objAttachments.Count or msgbox objMsg.subject & objAttachments.Count after
      lngCount = objAttachments.Count line to see if it's rolling through the other messages or just ending.

      If you use msgbox, only select a few messages - otherwise it is annoying. Debug.print will show in the Immediate window - you can show it from the View menu in the VBE.

  9. Suzanne

    (from the original posted code). Any ideas?

  10. Osbaldo Martinez Garcia

    Hi Diana, thank you very much for the macro, which is the only way to download xml files? is it possible?

    Thanks and Regards

    1. Diane Poremsky

      It doesn't work with xml attachments? It *should* work with all attachments. I know XML may be handled differently in OWA but it should work in Outlook.

  11. Kevin Thomas

    Hi, Diane,
    Thank you so much for this. I tried changing strFolderpath and the script fails without any sign of an error - the file just doesn't get where I set it. Any guidelines about how to refer to file locations? I'm a complete noob to VBA. Thanks in advance for any help you can give.

    -Kevin

    1. Diane Poremsky

      Step into each line using Debug > Step into or F8. Is it skipping any lines?

      While you are stepping into the code, you can hover the mouse over the strFolderpath line (after you move to the next line) and see the path the macro wants to use - but basically, it uses your My Documents and you need to use \ to identify the folders, strFolderpath does not include it. If you leave a slash off, it's added to the previous folder name or prefix to the filename. The subfolder also needs to exist.

      If you use strFolderpath = strFolderpath & "\OLAttachments", the attachment is saved as C:\Users\Diane\Documents\OLAttachmentsfilename.extension

      and strFolderpath = strFolderpath & "OLAttachments\" looks for C:\Users\Diane\DocumentsOLAttachments\filename.doc

  12. jzelnock

    Diane,
    Is there a way to add the Outlook 'SentOn' date to the saved filename so I can easily match it to the email it was attached to?
    J Zelnock

    1. Diane Poremsky

      Yes, you just need to format the value in the field and add it to the file name.

      At the top:
      Dim dtDate As Date
      Dim sName As String

      Replace the for i =... and first strFile lines with this:

      dtDate = objMsg.SentOn
      ' format date/time as 20130905045911-
      sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
      vbUseSystem) & Format(dtDate, "hhnnss", _
      vbUseSystemDayOfWeek, vbUseSystem) & "-"

      For i = lngCount To 1 Step -1

      ' Get the file name.
      strFile = sName & objAttachments.Item(i).FileName

  13. jzelnock

    Diane,
    Worked like a charm. Thank you so much.
    Janice Zelnock

  14. jzelnock

    Diane,
    One more question. Occasionally I'm finding that certain senders used embedded images in their signatures. The macro reads these images as attachments. Is there any way to prevent that from happening?
    Janice Zelnock

    1. Diane Poremsky

      That is the one big limitation... you can't prevent it completely, but if you don't need to save images you can add an if statement. Or you can save only files larger than a certain size, say 5 kb. That size will still catch a few signature images, but if file you want to save are well over that, you can go higher.

      Try adding something like this after you count the attachments.
      For Each objAttachments In objMsg.Attachments
      If objAttachments.Item(i).Size > 5200 Then
      ' do the save stuff

      End If
      Next objAttachments

      I'll test it and update the page with the code.

    2. Diane Poremsky

      That was a little overkill - you only need the if statement for the file size (and the end if)

      For i = lngCount To 1 Step -1
      If objAttachments.Item(i).Size > 5200 Then
      ' create filename, save it

      End If
      Next i

  15. Lydia

    I'm looking for a way to save the attachment as the email address of the sender (that way I can easily identify in the folder who sent which attachment). How would I define that in the code?

    1. Diane Poremsky

      use something like strFile = objMsg.senderemailaddress & "-" & objAttachments.Item(i).FileName

  16. Jack

    Is there a way to use a service account to save to a network location that the user does not have access to?

    1. Diane Poremsky

      I don't know if there is a way to pass the logon if you don't map the drive, but this should work
      persistent = false
      set objNetwork = WScript.CreateObject("WScript.Network")
      objNetwork.MapNetworkDrive "driveletter:", "\\server\folder", persistent, "username", "password"

  17. englishgent

    Hi Diane,

    Thank you for taking the time to write these tips and answer people's questions.

    What I'd find really useful is for the macro to insert the filepath and filename of the saved attachments into the top of the email body. That way, I could quickly determine whether an email had any attachments, and go and find it/them in the folder in which they are saved.

    I think what I'm asking for is to add the 'strFile' value to the start of the email body. If this could be done as a hyperlink, it would be fantastic, although just plain text would be much better than nothing. Do you know of a way to do this?

    Many thanks for your help.

    1. Diane Poremsky

      The original code from outlook-tips added it at the end - to add it to the top, switch the order in the objMsg.Body = lines.
      If objMsg.BodyFormat <> olFormatHTML Then
      strDeletedFiles = strDeletedFiles & vbCrLf & ""
      Else
      strDeletedFiles = strDeletedFiles & "
      " & "" & strFile & ""
      End If

      Next i
      'End If

      ' Adds the filename string to the message body and save it
      ' Check for HTML body
      If objMsg.BodyFormat <> olFormatHTML Then
      objMsg.Body = objMsg.Body & vbCrLf & _
      "The file(s) were saved to " & strDeletedFiles
      Else
      objMsg.HTMLBody = objMsg.HTMLBody & "

      " & _
      "The file(s) were saved to " & strDeletedFiles & "

      "
      End If
      objMsg.Save

  18. neilv

    I used to use this code a while back but running it with the msg box just now I can see there is an issue with the path for

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    and..

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "J:\Mail Backups\OLAttachments"

    It appears to be referencing a backup sync folder on our network rather then my documents locally.

    thus the attachement folder ends up

    servername/home/profilenameJ:\Mail Backups\OLAttachments

    is there anything i can do about this?

    1. Diane Poremsky

      This is wrong - strFolderpath = strFolderpath & "J:\Mail Backups\OLAttachments"

      if you want it in the backups folder, use
      use strFolderpath = "J:\Mail Backups\OLAttachments\"

      or strFolderpath = strFolderpath & "\OLAttachments\" if you want it a subfolder in the temp folder.

  19. Neilv

    Perfect, Many thanks Diane, I wonder where the correct piece of code i was using a few months ago went lol. Thank you again

  20. ZimN27

    Hi Diana! Thank you so much for providing these code and some of your knowledge.
    This macro works flawlessly with the exception of not keeping the files with the same name.

    I have over 1000 email to work with an attachment in excel and all have the same name.

    Can you help me?

    Thank you very much.

    1. Diane Poremsky

      Add the received date to the the file name- there is a code sample there that does it.

  21. ZimN27

    Very grateful! I had never worked with VBA before. I'm a layman.
    You've no idea how it helped me!
    Diane is the best!
    Obrigado (Portugal)

  22. Andy McCarthy

    Hello Diane!

    My script creates a new folder on a mapped network drive in which to save the attachments, but I encounter an error when I actually try to have the script save the attachments (I receive an error message that I don't have permission). It seems odd that I can create a folder via VBA but the same macro can't then save to that newly created folder. I don't have this error if I create then save to a folder on my local hard drive, only when trying to save to a mapped drive. As always, I'd be very grateful if you could point me in the right direction! Thanks, Andy

  23. Andy McCarthy

    Hi Diane - I'm sorry: I didn't realize you had later posted the code. Thanks very much. I'm going to try it. Andy

  24. Andy McCarthy

    Hello again - please disregard. I figured out the issue. The error was in my code. I wasn't putting together the strings correctly and had also left out .DisplayName which means there was no filename to save. Duh. Thanks!

    1. Diane Poremsky

      Thanks for the update. I'm sure you aren't the only one who makes silly mistakes like that. :)

  25. henri

    BrowseForFolder is close to what I want, but I can't navigate anywhere with it is the another shell application I could use instead?

  26. henri

    I should elaborate. I get the browseforfolder dialog, but the ability to browse is there. No crosses next to folders, no tree structure down the left. What do I need to do to get it working correctly. I've seen mention of IE4 and 5, I've got 11. But I don't see why the later version would matter. The pics I've seen seem to indicate later versions should be O.K.

    1. Diane Poremsky

      I don't think the browser version is the problem. If you click on folders do they expand?

  27. Kevin B

    First off, thanks for all the vba help! I have referenced your material quite often.

    How would you modify the above code to save the email attachments to a created folder using the subject as the folder name?

    Thanks in advance!

    1. Diane Poremsky

      so you want to save a message with the subject "Howdy Kevin" to a folder at \My Documents\Howdy Kevin\document.docx - try something like this:
      strFile = strFolderpath & "\" & objMsg.subject & & "\" strFile

      You'll probably need the file scripting object to create the folder

  28. Santi

    Hi Diane,

    Do you know how to create script in outlook that will automatically unzip an attachment when an email arrives and save it to local folder ?

    I have to extract the attachment & save the file from distributor every day. But because I have to do it manually, sometime I forgot or missed to do it.

    Can you please help me ?

    warmth regard,
    Santi

    1. Diane Poremsky

      it would depend on the application you use to unzip - if it can be controlled by command line, you could probably do it from a macro.

  29. thomas d

    Hello Dian,
    Is there anyway to have it so that each attachment is name after the subject line of the email it came from? And if there is more than one attachment, it will just be saved as "example" and "example (1)".
    Thanks!

    1. Diane Poremsky

      you can add the name but it won't add (1) to the names - you'll need to use code that adds a number. I'd probably recommend using subject-attachmentname format to avoid problems.

  30. John

    Hello Diane
    Looking for a VBA by which I could extract / save all the PDF attachments from a particular mail. However these mails have further email attachments in them inside which lies these PDF files.
    So basically it has to fetch all the attachments from the sub-msg files when the parent email is selected.

    Is there a way to do this?

    1. Diane Poremsky

      i think its doable - you need to save the attached message, pass it to the code as the new message object then open the attachment. you might need to use the code here - http://www.slipstick.com/developer/open-outlook-messages-stored-filesystem/ - on the msg attachment to get to the file attachment.

  31. RD

    Diane,

    I setup this script in Outlook 2013 and modified the folder location but when the rule runs nothing is being placed in the folder. It doesn't error out and the progress bar runs across as if the script is successful but no go. Can you tell me what I modified wrong please?

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    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

    ' Get the path to your My Documents folder
    ' strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    ' On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objAtt = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objAtt.ActiveExplorer.Selection

    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = "C:\AutoAttach"

    ' 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

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

    Next i
    End If

    Next

    End Sub

    1. Diane Poremsky

      This one, with (itm as outlook.mailitem) in the macro name, should run in a rule. Itemadd in the macro name would run as items are added to the folder.

    2. Diane Poremsky

      if it's running as a rule, you don't need to set the outlook.application or use the selection and the message object is 'itm'.

      Try this:
      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAttachments As Outlook.Attachments
      Dim i As Long
      Dim lngCount As Long
      Dim strFile As String
      Dim strFolderpath As String

      ' Set the Attachment folder.
      strFolderpath = "C:\AutoAttach\"

      Set objAttachments = itm.Attachments
      lngCount = objAttachments.Count

      If lngCount > 0 Then

      For i = lngCount To 1 Step -1
      strFile = objAttachments.Item(i).filename
      strFile = strFolderpath & strFile
      objAttachments.Item(i).SaveAsFile strFile
      Next i
      End If
      End Sub

    3. Diane Poremsky

      Oh, and the file path needs to end with \ - otherwise the attachmnents are saved to C:\ and named autoattachfilename

  32. RD

    Never mind I figured it out. It runs as a macro but not as a rule. - thank you

  33. AyoolaAlam

    Hi Diane,

    Thank you for taking the time to write these tips and answer people's questions.

    Pls have been trying to create a folder path i.e when the customized ribbon is clicked, it ask the user to browse to the folder path to save the selected mail. Here is my sample code but its not working. Pls can U pls help

    Option Explicit
    Public Sub SaveMessageAsMsg()
    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath As String
    Dim dtDate As String
    Dim sName As String
    Dim enviro As String
    Dim strFile As String
    Dim olMSG As String

    For Each objItem In ActiveExplorer.Selection
    Set oMail = objItem

    sName = oMail.Subject

    dtDate = oMail.SenderName

    sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

    sPath = BrowseForFolder("T:TempCorrespondence")
    strFile = sPath & "Correspondence" & strFile

    Debug.Print sPath & sName
    oMail.SaveAs sPath & sName, olMSG
    MsgBox ("Message is Successfully Copied")
    Next
    End Sub

    Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    End Function

    1. Diane Poremsky

      What happens when you try it? Does T:\Temp\Correspondence exist?

    2. AyoolaAlam

      Thanks alot for you response,
      Yes the path exist it was returning an error at "oMail.SaveAs sPath & sName, olMSG" which says "Tye MissMatch". Pls what do you think might be wrong. Thanks alot

    3. Diane Poremsky

      Does the path exist? use debug.print or a msgbox to display the folder path and file name so you can verify it exists.

  34. stushapiro

    Thank you so much for this. Its a bit over my head but im piecing things together as i dont do programming.

    Can you help modify this simple script i have working.
    The script currently saves out all the files as ".jpg" as .jpeg wont work for my needs.

    *I simply want to add that it only saves ".jpeg" and ".jpg" and ignores all other attachments
    __________________________________________

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat As String
    Dim strFileExtension As String

    saveFolder = "C:\emails\"
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    strFileExtension = ".jpg"

    For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName & strFileExtension
    Set objAtt = Nothing
    Next
    End Sub

    __________________________________________

    1. Diane Poremsky

      See the last macro snippet in the article for an example of a way to check for different extensions. You need to count the attachments and check each one for the file extension.

    2. stushapiro

      Hi Dave,

      thasnk for the reply. I did see that, its just over my head as im not a programmer. i dont know where or how to add that to my current code. I'm learning by taking things i understand and breaking down examples. This one is just a bit over my head.!

    3. Diane Poremsky

      If you only need to look for jpg or jpeg, you can wrap the line that saves the file in an If/End if statement - the end of your code would look like this:

      For Each objAtt In itm.Attachments

      If LCase(Right(objAtt.filename, 3)) = "jpg" or LCase(Right(objAtt.filename, 4)) = "jpeg"
      objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName & strFileExtension
      end if
      Set objAtt = Nothing
      Next
      End Sub

      i didn't test your code - does it work ok? I think the set objatt = nothing should be after the next, not before it.

    4. stushapiro

      this has a syntax error so cant test it

    5. Diane Poremsky

      Oh, I forgot the Then at the end of the If line.

  35. Stu Shapiro

    Can anyone help fix this code, red line on the strSaveFilename and nothing hapepens when i run it
    .
    Is saves .JPEG and JPG with the date.
    Converts suffix to lower case
    Saves only jpg files to the emails folder

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat As String
    Dim strFileExtension As String
    Dim strSaveFileName as string

    saveFolder = "C:\emails\"
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    strFileExtension = ".jpg"

    For Each objAtt In itm.Attachments
    if lcase(right(objAtt.FileName, 4)) = "jpeg" or lcase(right(obtAtt.FileName, 3) = "jpg") then

    strSaveFileName = mid(objAtt.FileName, instr(1, objAtt.FileName, ".", length(objAtt.FileName) - instr(1, obtAtt.FileName)) & strFileExtension
    objAtt.SaveAsFile saveFolder & "\" & dateFormat & strSaveFileName
    Set objAtt = Nothing
    End if
    Next
    End Sub

    1. Diane Poremsky

      typos/spelling errors seems to be the main problem -
      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim dateFormat As String
      Dim strFileExtension As String
      Dim strSaveFileName As String

      saveFolder = "C:\Users\Diane\Documents\"
      dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
      strFileExtension = ".jpg"

      For Each objAtt In itm.Attachments
      If LCase(Right(objAtt.FileName, 4)) = "jpeg" Or LCase(Right(objAtt.FileName, 3) = "jpg") Then

      strSaveFileName = Mid(objAtt.FileName, InStr(1, objAtt.FileName, ".", Len(objAtt.FileName) - InStr(1, objAtt.FileName))) & strFileExtension
      objAtt.SaveAsFile saveFolder & "\" & dateFormat & strSaveFileName
      Set objAtt = Nothing
      End If
      Next
      End Sub

    2. Diane Poremsky

      BTW, it doesn't look like strSaveFilename is doing anything except adding the file extension twice.

    3. Stu Shapiro

      Thank you so much Diane, its working :) saving only .jpg files to the folder! awesome!

    4. Stu Shapiro

      Just another THANK YOU!

  36. vicky

    Hi Diane Poremsky,

    Thank you sharing this wonderful and useful coding.
    It is really helping me..
    However, if you could tell me the coding to change the desired location other than my documents.
    It will be very helpful.
    Hoping to hear from you soon

Leave a Reply

If the Post Comment button disappears, press your Tab key.

This site uses XenWord.