Save and Delete Attachments from Outlook messages

The following is the Save Attachment code sample from Teach Yourself Outlook in 24 Hours.

Frank modified the code to break it into a single call for each mail item so you can use it with a rule to filter incoming mail. Frank's code modification (page 2)

Augusto modified Frank's code "in order to avoid file overwriting when the attachment name is the same as an existing one (i.e. details.txt on a return receipt email). Now, the attachments are saved in the format “SenderName.ReceivedDate.filename.ext” and then the attachment is deleted from the original email." Augusto's code modification (page 3). Also on page 3, a version that deletes all attachments in the selected folder.

To use, first create a folder under your My Documents named OLAttachments. Then select one or more messages and run the macro to save and remove the attachments. (May wish to comment out the line that deletes the attachment before testing). Remove or comment out the MsgBox lines after testing.

To delete the attachments without saving them, leave just these lines between the If... and End if. (The macro can also be edited to remove the statements above the If command that are no longer needed.)

If lngCount > 0 Then
For i = lngCountb To 1 Step -1

' Delete the attachment.
objAttachments.Item(i).Delete

Next i
objMsg.Save

End If

Copy and paste the code from this page into your ThisOutlookSession project. To do this, you can either move your mouse to the right of the first line and click the Copy button (or view source code button then select all, copy and paste). Or copy it from this text file: Save and Delete Attachments. After pasting the code into the VB Editor, it should be colored similar to the code below. A Red line indicates problems with the line.

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.

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

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

    'Use the MsgBox command to troubleshoot. Remove it from the final code.
    MsgBox strFolderpath

    ' Check each selected item for attachments. If attachments exist,
    ' save them to the Temp folder and strip them from the item.
    For Each objMsg In objSelection

    ' This code only strips attachments from mail items.
    ' If objMsg.class=olMail Then
    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    
    'Use the MsgBox command to troubleshoot. Remove it from the final code.
    MsgBox objAttachments.Count
    
    If lngCount > 0 Then
    
    ' We need to 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
    
    ' Save attachment before deleting from item.
    ' 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
    
    ' Delete the attachment.
    objAttachments.Item(i).Delete
    
    'write the save as path to a string to add to the message
    'check for html and use html tags in link
    If objMsg.BodyFormat <> olFormatHTML Then
        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
        Else
        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
        strFile & "'>" & strFile & "</a>"
    End If
    
    'Use the MsgBox command to troubleshoot. Remove it from the final code.
    MsgBox strDeletedFiles
    
    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 & "<p>" & _
        "The file(s) were saved to " & strDeletedFiles & "</p>"
    End If
        objMsg.Save
'sets the attachment path to nothing before it moves on to the next message. 
        strDeletedFiles = ""

    End If
    Next
    
ExitSub:

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

Code Modifications

Frank's code modification (page 2) Augusto's code modification (page 3). Also on page 3, a version that deletes all attachments in the selected folder.

  • Josh

    Brilliant code!!! Exactly what I was looking for. And thanks for the super easy instructions to follow. The only difference I found was that in Outlook 2010 Alt+F11 didn't work, so I just had to turn the developer toolbar on.

  • outlooktips

    Alt+F11 works with Outlook 2010 - why it didn't for you is a mystery. (Sometimes other apps interfere and hijack the shortcuts.)

  • JRM

    Any chance the code can run without prompts of any kind?

  • Diane

    Security prompts or the message boxes telling you want is happening?

    The lines of code beginning with MsgBox can be deleted - they are just there so you can see what is happening. They can be very useful for troubleshooting.

    Either delete or add a ' in front of each msgbox to disable it - like this:

    ' MsgBox strDeletedFiles

  • JonasL

    Great script, however when I mark several messages the text in each e-mail that tells you were the files were saved contains ALL files that were saved and removed, i.e. not only the attachements that were removed from that specific e-mail. Anyone else that experience this problem? Suggestions for fixing it?

    Thanks!

  • Diane Poremsky

    It's been a long time since I wrote the code, but I think its meant for single message use. For multiple messages you need to do a loop and clear the values before moving to the next message.

    With just looking at it here quickly, so I could be wrong, it might work to reset the strAttachments value or objAttachments before looping.

  • JonasL

    Perfect, I just resetted the strDeletedFiles after each loop and now it works like a charm.

    Thanks!

  • Diane Poremsky

    Cool. Thanks for sharing.

  • Mohan

    I would like to keep attachment file names in the email message whenever I remove/delete attachments from the email. This feature was there in Lotus Notes. How to get this feature in Outlook?

    Thanks
    Mohan

  • Diane Poremsky

    You need to use an addin or VBA - the code on this page does it with this line: strDeletedFiles = strDeletedFiles & "" & "" & strFile & ""
    if you want just the file name and not the save path, you can edit the code to remove the parts that remember the path.
    See http://www.slipstick.com/addins/attachment-management-tools-for-outlook/ for addins that will do this for you.

  • Darryl Gittins

    Lookks nice but the script fails for me with a run-time error'9', subscript out of range:

    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

  • Diane Poremsky

    I can't repro that error - I thought maybe it was because you didn't create the olattachments folder under My Documents - but the code runs error free, it just doesn't actually save the attachments. (I am getting a block-end if error, not sure why since no one else complained.)

    What version of Windows? Is Windows Scripting installed/enabled?

  • kavsoo

    This code works only when the outlook is opened by the user, is there a way to make it work automatically (assuming the inbox never gets opened, and all the attachments coming to this inbox should get stored in a folder). Appreciate inputs.

  • Diane Poremsky

    The only way to run code on a mailbox that is never opened, is to do it on the server. Outlook (or any mail client) needs to check for new mail and download it before it can process it.

    Is this an exchange mailbox? If so, a server-side event sink or, if you open the mailbox as a secondary mailbox, tweaking the macro should work.

  • Frank Bello

    Thanks so much for compiling this code. Quite of some help!
    I modified the structure to break the code into a single call for each mail item. THis way, the code can be used for all items selected, but at the same time a RULE can invoke the code also when incoming mail hits the box. here's the modification.

    [admin note: click the link to view Frank's code or open the text file linked near the top of this page.]

    Public Sub SaveAttachments()
        Dim objOL As Outlook.Application
        Dim pobjMsg As Outlook.MailItem 'Object
        Dim objSelection As Outlook.Selection
    
        ' Get the path to your My Documents folder
        strFolderpath = CreateObject(&quot;WScript.Shell&quot;).SpecialFolders(16)
        On Error Resume Next
    
        ' Instantiate an Outlook Application object.
        Set objOL = CreateObject(&quot;Outlook.Application&quot;)
    
        ' Get the collection of selected objects.
        Set objSelection = objOL.ActiveExplorer.Selection
    
        For Each pobjMsg In objSelection
            SaveAttachments_Parameter pobjMsg
        Next
    
    ExitSub:
    
        Set pobjMsg = Nothing
        Set objSelection = Nothing
        Set objOL = Nothing
    End Sub
    
    Public Sub SaveAttachments_Parameter(objMsg As MailItem)
        Dim objAttachments As Outlook.Attachments
        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(&quot;WScript.Shell&quot;).SpecialFolders(16)
        On Error Resume Next
    
        ' Set the Attachment folder.
        strFolderpath = strFolderpath &amp; &quot;OLAttachments&quot;
    
            ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
    
            If lngCount &gt; 0 Then
    
                ' We need to 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
    
                    ' Save attachment before deleting from item.
                    ' Get the file name.
                    strFile = objAttachments.Item(i).FileName
    
                    ' Combine with the path to the Temp folder.
                    strFile = strFolderpath &amp; strFile
    
                    ' Save the attachment as a file.
                    objAttachments.Item(i).SaveAsFile strFile
    
                    ' Delete the attachment.
                    'objAttachments.Item(i).Delete
    
                    'write the save as path to a string to add to the message
                    'check for html and use html tags in link
                    If objMsg.BodyFormat  olFormatHTML Then
                        strDeletedFiles = strDeletedFiles &amp; vbCrLf &amp; &quot;&quot;
                        Else
                        strDeletedFiles = strDeletedFiles &amp; &quot;&quot; &amp; &quot;&lt;a href='//&quot; &amp; _
                        strFile &amp; &quot;'&gt;&quot; &amp; strFile &amp; &quot;&lt;/a&gt;&quot;
                    End If
                Next i
            End If
    
            ' Adds the filename string to the message body and save it [COMMENTED AS THIS FUNCTION WAS NOT DESIRED]
            ' Check for HTML body
            '        If objMsg.BodyFormat  olFormatHTML Then
            '            objMsg.Body = objMsg.Body &amp; vbCrLf &amp; _
            '            &quot;The file(s) were saved to &quot; &amp; strDeletedFiles
            '        Else
            '            objMsg.HTMLBody = objMsg.HTMLBody &amp; &quot;&quot; &amp; _
            '            &quot;The file(s) were saved to &quot; &amp; strDeletedFiles &amp; &quot;&quot;
            '        End If
            objMsg.Save
    ExitSub:
    
        Set objAttachments = Nothing
        Set objMsg = Nothing
        Set objOL = Nothing
    End Sub
    
  • kavsoo

    Thank you Diane for your response;

    Here's my situation, this is an exchange mailbox. I'm afraid that the IT admin will allow me to set up a server-side event for a small task, so this is out of the question.

    So can you explain more about "opening the mailbox as secondary and tweaking the macro"?

    thanks again

  • Nick

    Hi, thanks for publishing this. It would really help if the macro were able to create a subfolder for each email's attachments, labelled with the Subject of the email (truncated and cleaned of unusable characters if needed) with a _YYYY MM DD_hh mm ss suffix for date and time received. Does anyone know how to add this easily?

    Thanks again.

  • Christopher W. Brown

    Thanks for the code. I tried using it a few months ago but got syntax error messages. Not a VBS guy and this is the first time I've attempted programming outlook so I put it off. I revisited it today when I had some time. Anyway, I am using Outlook 2007 on Windows 7 Pro and I had to replace all of the '&' with just the '&' and the '>' and '<' with actual > and < signs. Now it works as advertised.

    The msg box didn't really look correct either. It was displaying the html text in the box. But I was able to know what it was telling me and now I've debugged and deleted the MsgBox stuff so I'm good. Thanks again for the code. Just wanted to inform those who may get the syntax error using the '&' type commands.

    (Also had to Ctrl-V to paste code not Ctrl-P.)

  • Diane Poremsky

    Thanks for bringing the problems to my attention. I'll fix the code... again. (Code samples are the one big failing with WordPress.)

  • Rob

    Wow this is great, thanks! Clear, well commented and well thought out. You're very good

  • John Fitzgerald

    Awesome! Thanks. Anyone know how to keep the paperclip icon?

    Also, I had to comment out the last End If for some reason.

  • Diane Poremsky

    You can't keep the paperclip unless there is an attachment - you can remove the line from the code that deletes the attachment or rework it to add a small attachment to the message.

  • James

    I have the same situation. Have you found a solution yet?

  • rakesh seebaruth

    Hi ,

    i have a master copy file named(master copy.xls).whatever name is given in cell "e5" is saved as by that name.(e.g if cell e5 is tom) then the file will be saved as tom.xls. My master copy file will remained unchanged. My problem is that when i attached the tom.xls file thru outlook .the latter does not send the file tom.xls but it send the master copy.xls file .Plz help My VBA Codes are below

    Sub save()
    mydrive = "C:"
    mydir = "excel"
    myname = Sheets("sheet1").Range("e5")
    Application.DisplayAlerts = False
    ThisWorkbook.saveas Filename:=mydrive & "\" & mydir & "\" & myname & ".xls"
    Application.DisplayAlerts = True
    End Sub

    Sub Mail_Workbook_1()
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
    .To = " aa@yahoo.com"
    .CC = ""
    .BCC = ""
    .Subject = Range("e5")
    .Attachments.Add ActiveWorkbook.FullName
    .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    End Sub
    rakesh seebaruth is offline Reply With Quote

  • Chris

    I have two questions:

    Question 1 -
    This code worked great, How would I modify this code so that it would save the email message to disk in an outlook message file format. The email messages that I am wanting to process do not have attachments and would like to know how to modify this code to save it to disk. Now I have to manually do a "File Save AS" and know I can get VB to do it for me automatically.

    This code worked so well for attachments that I know it would work good for just saving the msg to file.

    Question 2 -
    I am trying to make a "rule" in my outlook to process incoming emails with a certain subject line and then call the SaveAttachments VB code to run. I cant find a way to call this vb code macro. I can run the macro manually on an email message and it works just fine but can't see how to have a rule call this macro and run it automatically.

  • Chris

    I wanted to add to my above question # 2 that I used Frank's modified code that is supposed to break it into a single call for each mail item so you can use it with a rule to filter incoming mail but still did not understand how to get the rules to work with that code modification.

  • Augusto Papagno

    Hello:
    I did some modifications on Frank's code, in order to avoid file overwritting when the attachment name is the same as an existing one (i.e. details.txt on a return receipt email). Now, the attachemnts are saved in the format "SenderName.ReceivedDate.filename.ext" and then the attachment is deleted from the orinal email.

    Here is the code:

    Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim pobjMsg As Outlook.MailItem 'Object
    Dim objSelection As Outlook.Selection

    ' 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

    For Each pobjMsg In objSelection
    SaveAttachments_Parameter pobjMsg
    Next

    ExitSub:

    Set pobjMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
    End Sub

    Public Sub SaveAttachments_Parameter(objMsg As MailItem)
    Dim objAttachments As Outlook.Attachments
    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

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

    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' We need to 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

    ' Save attachment before deleting from item.
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & objMsg.SenderName & "." & Format(objMsg.ReceivedTime, "yyyy-MM-dd h-mm-ss") & "." & strFile

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

    ' Delete the attachment.
    objAttachments.Item(i).Delete

    'write the save as path to a string to add to the message
    'check for html and use html tags in link
    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
    ExitSub:

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

  • Tony

    Thanks for the interesting information. However, I was wondering if anyone knows how to alter the Attachment Drag & Drop functionality with resepct to copying an attached file from Outlook to a Windows Explorer folder.

    When I drag an attachment to an Explorer folder, the date modified date/timestamp becomes "now" (current time), not the original attachement's date modified. Is there a way to preserve the original timestamp when dragging attachements out of Outlook?

    Thanks in advance.

  • Diane Poremsky

    To the best of my knowledge, no you can't change the behavior. It's always been a bit goofy, with the Window Explorer date taking Outlook's time stamps if the message was received within a certain time period (approx 2 weeks prior). Augusto's code sample will add the received to the filename field - not quite the same, but it can help. I'll see if i can put together some VBA that will set the Windows time stamp using the received time.

  • Nick

    Hi, this looks great - thanks. Unfortunately, I get a Compile error: Syntax error when I try to run it. The code breaks at "If objMsg.BodyFormat olFormatHTML Then" - it seems to want a Then or GoTo immedaiately after "If objMsg.BodyFormat". Any thoughts?

    As a possible enhancement, would it be straightforward to remove the attachments and instead of adding text to the email, replace the attachments with a text file listing the attachments and their new locations or even a file with active links to the removed files?

  • Nick

    Hello again - figured that out by reviewing other code online - seems it just needed a not equals sign, to read “If objMsg.BodyFormat olFormatHTML Then”. I wonder why it works without for some people.

  • Nick

    Hi - thanks for all the work on this, it's just great. However, I would prefer to replace the attachments with a text file indicating the location of the saved attachments, rather than adding text to the end of the message body. Does anyone know how to do this?

  • Ray

    Hello,
    I receive emails that contain .pdf, .txt., .doc and other types of attachments. I would be very grateful if someone could show me how to modify the above code so that I can remove and save all attachments but leave any pdf files in the emails if they exist.

  • Ray

    Forgot to include that i use Outlook 2003 on Win XP.

  • Nick

    This macro is great! It is a feature that should be built-in! Especially useful for those of us who have limits on mailbag size.

    I'd like to add a link to the OLAttachments folder in the message.
    I can make it work with Rich Text but not with HTML messages.

    I just replace the "strDeletedFiles" with "strFolderpath" but it doesn't work.

  • Diane Poremsky

    @nick what happens when you try? Because the code adds file names to strFolderpath, it might work better to make a new string variable that is used only for the folder path:

    dim strFolderOnlypath as string
    strFolderOnlypath = strFolderpath & "OLAttachments"

    If objMsg.BodyFormat <> olFormatHTML Then
    objMsg.Body = objMsg.Body & vbCrLf & _
    "The file(s) were saved to " & strFolderOnlypath
    Else
    objMsg.HTMLBody = objMsg.HTMLBody & "

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

    "
    End If

  • Pedro M. Lledó

    Hi all,
    I'm trying to modify Augusto's script in order to be able to select a folder to save the attachments, instead of saving it to the My Documents\OLAttachments.
    I'm trying the FolderBrowserDialog object, but I got an error about user-defined type not defined, when compiling the visualbasic code. I'm trying to link the right Library in Tools-->References, but no success.

    I'm using Outlook 2007 on Win7
    What I'm missing?

    Please advice and thanks a lot for your help in advance.
    Kindest,
    Pedro

  • Diane Poremsky

    Which library are you referencing?

  • Jen

    Hello, all.
    I'm having trouble with the following two lines. VBA wants an expression, but in all of my searching, I have not found a fix. Any help is appreciated!

    strDeletedFiles = strDeletedFiles & "" & "" & strFile & ""

  • Jen

    Me again. It didn't paste the second line that is giving me an error:
    strFile & "'>" & strFile & ""

  • Diane Poremsky

    Make sure the quotes are not "smart quotes" - it pasted fine for me just now so that should be ok for you.

    Backspace that line to make one line with the previous line - so instead of
    [stuff] & _
    strFile [stuff]

    it will be [stuff] & strFile [stuff]

  • Aaron

    Thank you for the code example! I think I've worked through the difficulties presented by the website here not displaying all of the actual code correctly and am down to one problem with building strDeletedFiles for non-HTML messages. For some reason it ignores vbCrLf and just smushes all my links together in a single line.

    This is what I have:
    strDeletedFiles = strDeletedFiles & vbCrLf & ""
    (not sure the end of this will display properly but basically I am adding on a

    I've tried vbNewLine as well, and have tried just inserting Chr(10) & Chr (13). Any ideas?

    Interestingly, when I build objMsg.Body and use vbCrLf it works fine

  • Aaron

    Haha, even my explanation didn't work properly. To be clear it's:
    strDeletedFiles = strDeletedFiles & vbCrLf & "" & strFile & ""

  • Aaron

    I can't win. Oh well... I'm building a file tag around strFile so Outlook will link it even in a text message.

  • asdfasdfasdf

    dont use this script as it will overwrite any attachments with the same name and then delete them making them unrecoverable. Very embarassing situation for me thanks to this.

  • Diane Poremsky

    Did you read the note in the yellow block at the top? Augusto shared code with us that saves the items with a name format of SenderName.ReceivedDate.filename.ext to prevent this problem.

  • Anthony Shelton

    I love this script, however I am running into one major issue.

    My companies signature uses .png and .jpeg images. These objects are recognized as "attachments" by this script, and are stripped and stored with the legitimate attachments.

    Is there any way I could alter this script to ignore these signature elements, and only apply to mail message attachments directly under the Sent: and To: columns?

  • Diane Poremsky

    You can't tell it to skip signatures - it doesn't identify an attachment as part of a signature.

    If the attachment name is always the same "company-logo.png" you can could use an If statement to skip them. If you want to skip all png or jpg attachments, you could do that too. '

    It would be something like this:

    strFile = objAttachments.Item(i).FileName

    If strfile <> "company-logo.png" then
    strFile = strFolderpath & strFile
    objAttachments.Item(i).SaveAsFile strFile
    else
    strfile = ""
    End if

    objAttachments.Item(i).Delete

  • Andy

    hello, thanks for the code...can this work on specific folders rather than all folders/inbox

  • Diane Poremsky

    Yes, This line: Set objSelection = objOL.ActiveExplorer.Selection tells it to work with the selected messages. They can be in any folder.

  • Andy

    Thanks Diane, I get an error when I add 'Set objSelection = objOL.ActiveExplorer.Selection ' into the code...where should this go?

  • Andy

    also, how do I change the path so saves to eg "C:\Attachments" (substituting that into the code doesnt seem to have worked)

    thanks

  • Diane Poremsky

    Where did you stick it in?

    This line uses one of the special windows folders (My Docs):
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

    And this sets the subfolder.
    strFolderpath = strFolderpath & "OLAttachments"

    Remove the first strFolderpath line and replace with second with this and it should work.
    strFolderpath = "C:\Attachments"

  • Diane Poremsky

    It's already in the code - you don't need to add it. It's the 3rd line in the code.

  • Ford

    Thank you for the great and very useful example. With a little effort, it does a great job and has taught me a great deal about macros and VBA within Outlook.

    On the question (and suggestion) for skipping embedded images (as in company logos), I thought of a couple of other methods, but am not adept enough to make it work. Is there perhaps a way to examine a property of the attachment to determine it is embedded within the body?

    Another thought for me was to examine the attachment file size and skip it if it was less than,,, say, 15KB.

    And yet another thought was to check the file extension for being a .png or .jpg. I have seen these embedded logos with various names, so checking for a specific name as you suggested is not effective in all cases.

    Thank you again for the really great lessons.

  • Diane Poremsky

    Checking for the file extension is probably the best option. I didn't suggest it because if you get jpg or png you want saved, it won't work.

  • Kirk

    Well I used this code from page 3 along with code from http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/bbe6e55c-c52b-482b-8d99-14e080bbcdd5/ to save attachments I get and unzip them using an Outlook Rule trigger...


    Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim pobjMsg As Outlook.MailItem 'Object
    Dim objSelection As Outlook.Selection
    '
    ' 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
    '
    For Each pobjMsg In objSelection
    SaveAttachments_Parameter pobjMsg
    Next
    '
    ExitSub:
    '
    Set pobjMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
    End Sub
    '
    Public Sub SaveAttachments_Parameter(objMsg As MailItem)
    Dim objAttachments As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String
    '
    Dim FSO As Object 'variables for unzipping
    Dim oApp As Object
    Dim strFileZ As Variant
    Dim StrFolderpathZ As Variant
    '
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    '
    On Error Resume Next
    '
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\pcap\"
    StrFolderpathZ = strFolderpath 'pass it to unzip object variable
    '
    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    '
    If lngCount > 0 Then
    '
    ' We need to 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
    '
    ' Save attachment before deleting from item.
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    '
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & Format(objMsg.ReceivedTime, "yyyy-MM-dd h-mm-ss") & "." & strFile
    '
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
    strFileZ = strFile 'pass it on to the unzip variable
    '
    ' Delete the attachment.
    ' objAttachments.Item(i).Delete
    '
    'write the save as path to a string to add to the message
    'check for html and use html tags in link
    If objMsg.BodyFormat olFormatHTML Then
    strDeletedFiles = strDeletedFiles & vbCrLf & "" & strFile & ""
    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
    '
    ' Unzip the attachment if it is compressed as zip file
    If (Right(strFile, 3) = "zip") Then
    Set oApp = CreateObject("Shell.Application")
    oApp.NameSpace(StrFolderpathZ).CopyHere oApp.NameSpace(strFileZ).Items
    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    End If
    '
    ExitSub:
    '
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objOL = Nothing
    End Sub

  • Kirk

    p.s. the brackets (greater-than, less-than) have been stripped from comment input form

  • Diane Poremsky

    That's a wordpress bug (wordpress says its a feature)- wordpress thinks the brackets are for html. Hopefully it will be easier to read as code - i had to comment mark the blank lines to make it work for the entire code. :(

    I did a quickie scan and don't see any obvious missing brackets. Let me know if they are any that need fixed.

  • Johan AAnscharius

    Hi Kirk, Before deleting the attachment file, there should be the following check:

    Set FS = CreateObject("Scripting.FileSystemObject")
    if not FS.fileexists (strfile) then msgbox("OOps, could not save the file"): end

    That way you are sure the file is saved before deleting it.

  • Safwat Ammar

    Thank you so much, it is very helpful

  • Deepak

    This is a brilliant script - I used it with Outlook 2013 - no issues

  • steve

    Hello, first off...love this code! Thanks for posting. My issue is probably a simple one but I am not familar with Outlook coding enough to figure it out. I would like to modify this line "Set objSelection = objOL.ActiveExplorer.Selection" of the code so that I do not actually have to select all of the messages in a folder. I would like for the code to select all of the messages in a folder that I have selected and then proceed with moving the attachments.

  • Diane Poremsky

    That's not hard to do - i might have a sample at slipstick.com that does that, if not I will update this code so it does. I'm on vacation right now, so give me a few days and don't hesitate to remind me if I don't post something early next week.

  • steve

    Thanks Diane, sorry to bother you on your vacation. I did try the site you mentioned and found some code that will save outlook messages in a folder on the hard drive. This seems close to what I need but not quite. I only want to move the attachments of each message, not the entire message itself. Still, this may work with some tweaking. Maybe you could look at it to see what you think? I found it under "save all messages to hard drive using vba".

  • Diane Poremsky

    I'll take a look at it and see what needs changed.

  • steve tatum

    Hey Diane, have you had a chance to look at this yet?

  • Diane Poremsky

    I added a new version to page 3 - it will work on the selected folder.

  • steve tatum

    Thank you so much Diane! The changes you made work as expected...

  • Jason Levine

    I have a script that moves any message with an attachment to a user-selected folder, and the script moves not only attachments listed on the attachment line but also embedded or inline attachments, like signatures, or pasted in graphics. I would like to be able to eliminate these embedded attachments and only move the messages with the traditional attachments. I'm using Outlook 2010 and haven't found a good way to do this yet and any advice or direction would be appreciated.

  • Diane Poremsky

    Short version: you didn't find a way because their is no way to differentiate because attachments and embedded. However, there are two things you might be able to do: check attachment size and only move larger attachments. If the attachments you need to move are large this will work great - typical signature graphics are under 5 or 10 KB. Use a value high enough to get your attachments and skip most other attachments. Other option is to look at filename. If you only need to move pdf, you can see if the attachment filename ends in pdf.

    check attachment names
    check attachment size example