61 comments for “Save and Delete Attachments from Outlook messages”

1. Josh

   June 24, 2011 at 5:41 am

   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.
2. outlooktips

   June 24, 2011 at 1:51 pm

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

   July 8, 2011 at 7:04 am

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

   July 8, 2011 at 7:19 am

   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
5. JonasL

   August 5, 2011 at 2:57 am

   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!
6. Diane Poremsky

   August 5, 2011 at 4:44 am

   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.
7. JonasL

   August 5, 2011 at 5:51 am

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

   Thanks!
8. Diane Poremsky

   August 5, 2011 at 5:53 am

   Cool. Thanks for sharing.
9. Mohan

   September 14, 2011 at 7:03 am

   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
10. Diane Poremsky

    September 15, 2011 at 9:40 am

    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.
11. Darryl Gittins

    September 21, 2011 at 7:27 am

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

    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
12. Diane Poremsky

    September 21, 2011 at 8:03 am

    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?
13. kavsoo

    October 5, 2011 at 8:28 am

    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.
14. Diane Poremsky

    October 5, 2011 at 9:30 am

    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.
15. Frank Bello

    October 5, 2011 at 12:29 pm

    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("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 & 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 & "" & "<a href='//" & _
                        strFile & "'>" & strFile & "</a>"
                    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 & 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
    
16. kavsoo

    October 21, 2011 at 8:27 am

    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
17. Nick

    October 26, 2011 at 4:06 pm

    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.
18. Christopher W. Brown

    October 31, 2011 at 9:48 am

    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.)
19. Diane Poremsky

    October 31, 2011 at 10:33 am

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

    November 3, 2011 at 12:46 pm

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

    November 4, 2011 at 10:52 am

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

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

    November 5, 2011 at 8:44 pm

    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.
23. James

    November 23, 2011 at 2:46 am

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

    November 26, 2011 at 1:37 am

    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
25. Chris

    January 19, 2012 at 9:13 am

    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.
26. Chris

    January 19, 2012 at 9:17 am

    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.
27. Augusto Papagno

    January 26, 2012 at 11:09 am

    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
28. Tony

    February 13, 2012 at 7:29 am

    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.
29. Diane Poremsky

    February 13, 2012 at 8:15 am

    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.
30. Nick

    February 16, 2012 at 8:18 am

    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?
31. Nick

    February 16, 2012 at 1:25 pm

    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.
32. Nick

    February 16, 2012 at 3:59 pm

    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?
33. Ray

    April 8, 2012 at 12:24 pm

    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.
34. Ray

    April 8, 2012 at 12:52 pm

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

    May 9, 2012 at 9:09 am

    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.
36. Diane Poremsky

    May 9, 2012 at 11:44 am

    @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
37. Pedro M. Lledó

    May 11, 2012 at 8:21 am

    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
38. Diane Poremsky

    May 11, 2012 at 1:13 pm

    Which library are you referencing?
39. Jen

    September 12, 2012 at 9:09 am

    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 & ""
40. Jen

    September 12, 2012 at 9:11 am

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

    September 12, 2012 at 9:21 am

    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]
42. Aaron

    September 13, 2012 at 8:24 am

    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
43. Aaron

    September 13, 2012 at 8:27 am

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

    September 13, 2012 at 8:28 am

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

    October 17, 2012 at 10:57 am

    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.
46. Diane Poremsky

    October 17, 2012 at 11:27 am

    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.
47. Anthony Shelton

    January 11, 2013 at 1:13 pm

    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?
48. Diane Poremsky

    January 11, 2013 at 6:02 pm

    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
49. Andy

    January 29, 2013 at 9:58 am

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

    January 29, 2013 at 2:06 pm

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

    January 30, 2013 at 3:33 am

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

    January 30, 2013 at 9:47 am

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

    thanks
53. Diane Poremsky

    January 30, 2013 at 4:39 pm

    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"
54. Diane Poremsky

    January 30, 2013 at 4:43 pm

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

    February 4, 2013 at 2:50 pm

    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.
56. Diane Poremsky

    February 4, 2013 at 6:25 pm

    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.
57. Kirk

    April 18, 2013 at 6:39 pm

    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
58. Kirk

    April 18, 2013 at 6:41 pm

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

    April 18, 2013 at 11:28 pm

    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.
60. Johan AAnscharius

    May 9, 2013 at 10:27 am

    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.
61. Safwat Ammar

    May 13, 2013 at 2:32 am

    Thank you so much, it is very helpful