VBA – Removing attachments from Outlook email
One very powerful aspect of the Microsoft Office Suite of applications is the ability to create Macros and Scripts to perform various processes. This gives those of us who worked in Visual Basic 6 a chance to dust off our skills since the ‘flavor’ of Visual Basic used in the Microsoft Office applications (aptly called Visual Basic for Applications) is essentially the same.
A common request in Outlook is to process mail messages with attachments by removing the attachments and saving them to some specified folder. This can be accomplished with either a macro or a script. The script has an advantage of being something you can put into a rule so any incoming emails are processed automatically. Macros allow you to process only specific emails should you so desire.
My examples below are set to remove external calendar request files (.ICS or ICalendar format) and place them into the folder ‘ICSFiles’ set up in the standard ‘My Documents’ folder.
Public Sub SaveICSAttachments() ' to set this as a script the declaration would be ' Public Sub SaveICSAttachments(objitem As MailItem) Dim objOL As Outlook.Application '''''''''''''''''''''''''''''''''''' ' the next line removed if set up as a script Dim objitem As Outlook.MailItem 'Object ''''''''''''''''''''''''''''''''''' Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim i As Long Dim lCount As Long Dim sFile As String Dim sFolderpath As String Dim sDeletedFiles As String ' Instantiate an Outlook Application object. Set objOL = Application Dim objNs As Outlook.NameSpace Set objNs = objOL.Session Dim objFolder As Outlook.MAPIFolder ' Get the path to your My Documents folder sFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) On Error Resume Next ' Get the collection of selected objects. Set objSelection = objOL.ActiveExplorer.Selection ' Set the Attachment folder. ' You could check for the existance of the folder and ' prompt the user if you want sFolderpath = sFolderpath & "\ICSFiles\" ' Check each selected item for attachments. ''''''''''''''''''''''''''''''' ' Remove loop if used in script (you call script with the item) For Each objitem In objSelection ''''''''''''''''''''''''''''''''''''' ' Remove this check if running as a script ' This code only strips attachments from mail items. If objitem.Class = olMail Then ''''''''''''''''''''''''''''''''''' ' Get the Attachments collection of the item. Set objAttachments = objitem.Attachments lCount = objAttachments.Count If lCount > 0 Then ' Since we are removing things from an array, remove ' from the end going to the beginning For i = lCount To 1 Step -1 ' Save attachment before deleting from item. sFile = objAttachments.Item(i).FileName ' only looking for ICS file attachments If Right(sFile, 3) = "ics" Then ' Combine with the path to the Temp folder. sFile = sFolderpath & sFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile sFile ' remove attachment objAttachments.Item(i).Delete 'write the save as path to a string to add to the message If objitem.BodyFormat <> olFormatHTML Then sDeletedFiles = sDeletedFiles & vbCrLf & "<file://" & sFile & ">" Else sDeletedFiles = sDeletedFiles & "<br>" & "<a href='file://" & sFile & "'>" & sFile & "</a>" End If Next i End If ' Adds the filename string to the message body and save it If objitem.BodyFormat <> olFormatHTML Then objitem.Body = objitem.Body & vbCrLf & "The file(s) were saved to " & sDeletedFiles Else objitem.HTMLBody = objitem.HTMLBody & "<p>" & "The file(s) were saved to " & sDeletedFiles & "</p>" End If ' save the modified email with link to the detached file objitem.Save '''''''''''''''''''' ' remove if running as a script End If ''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''' ' remove loop if running as a script Next '''''''''''''''''''''''''''''''' ExitSub: Set objAttachments = Nothing Set objitem = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub
(Sorry for the screwed up code listing but the file link tags are being improperly interpreted by the plugin I use).
This macro was designed to run on Outlook 2007. You will most likely have to change the security settings in Outlook to have it run (and sign the macro or whatever). There is minimal (none) error checking in this code but then I’m not going to do it all for you.
You might also be interested in