More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 02-Sep-2014 04:06

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Login Password
Remember me
Register | Send my password
Code level: beginner    Code area: Basic Outlook Printer Friendly Version
Title: Save and remove attachments from email items (VBA)
Description: This is an easy to understand makro which works on selected items in an explorer (eg: Inbox)
Date: 26-Feb-2003  05:19
Code level: beginner
Code area: Basic Outlook
Posted by: Michael Brederlau
This message is displayed as plain text
 Sub SaveAttachment()

    'Declaration
    Dim myItems, myItem, myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    
    'Ask for destination folder
    myOrt = InputBox("Destination", "Save Attachments", "C:\")

    On Error Resume Next
    
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    
    'for all items do...
    For Each myItem In myOlSel
    
        'point on attachments
        Set myAttachments = myItem.Attachments
        
        'if there are some...
        If myAttachments.Count > 0 Then
        
            'add remark to message text
            myItem.Body = myItem.Body & vbCrLf & _
                "Removed Attachments:" & vbCrLf
                
            'for all attachments do...
            For i = 1 To myAttachments.Count
            
                'save them to destination
                myAttachments(i).SaveAsFile myOrt & _
                    myAttachments(i).DisplayName

                'add name and destination to message text
                myItem.Body = myItem.Body & _
                    "File: " & myOrt & _
                    myAttachments(i).DisplayName & vbCrLf
                    
            Next i
            
            'for all attachments do...
            While myAttachments.Count > 0
            
                'remove it (use this method in Outlook XP)
                'myAttachments.Remove 1
                
                'remove it (use this method in Outlook 2000)
                myAttachments(1).Delete
                
            Wend
            
            'save item without attachments
            myItem.Save
        End If
        
    Next
    
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
    
End Sub
All 190comments
Page [ 1 2 3 4 5 6 7 8 9 10 Next >>  
  26-Feb-2003  21:08   
This is something a lot of people ask about, Michael. Thanks for posting it! Possible enhancements might to use FileScriptingObject methods to check whether the folder exists and whether a file with the desired name already exists in the folder.
  27-Feb-2003  18:44   
Thank you Sue. Although every pice of code is available in the internet, much of it on your webs, sometimes it may be hard to find. My students asked me once for this little makro.



By the way, I love your work.
  04-Mar-2003  21:27   
That's the idea behind this site -- to try to move toward having more essential code samples all in one place. Thanks again!
  05-Mar-2003  07:49   
For another variation that saves the attachments to the system Temp folder, see http://www.slovaktech.com/code_samples.htm#StripAttachments
  07-Mar-2003  01:09   
How would I attach this macro to a button? Every time I put a macro on a button, it disappears the next time I open Outlook.
  11-Mar-2003  19:50   
A toolbar button? Those should persist between sessions. If not, the Outcmd.dat file might be corrupt. Try renaming it and letting Outlook build a new one.
  21-Mar-2003  17:11   
I need a macro that renames attachments of a .fax extension to .tif extensions by clicking a toolbar button. Can anybody help me? I'm a complete beginer. Altough I have worked with basic macros in Excel and Word quite extensively.
  25-Mar-2003  21:52   
The code above works on all items selected in the current folder. The piece that's missing for your project is the renaming, but all you really need to do to handle that is alter the SaveAsFile statement to change the file name to what you want it to be. You can use the Replace() function to substitute .tif for .fax.
  07-Apr-2003  12:42   
How I can execute this example from "rule";

in "select custom action" don?t appear macros.
  07-May-2003  17:48   
Daniel, you need Outlook 2002 to run a macro from a rule. You'd have to modify the above to add a MessageItem object as the argument for the procedure -- see http://www.slipstick.com/dev/code/zaphtml.htm for an example.
Page [ 1 2 3 4 5 6 7 8 9 10 Next >>