Last reviewed on March 9, 2015   —  19 Comments

A visitor to our forums had a script to save attachments to his hard drive and wanted to add the attachment's modified date to the filename.

To get the modified date (or any other file property), you need to use the FileSystem Object, or FSO, to read the properties.

Instead of using the file's modified date, or if Outlook is not getting the expected modified date, you can use the email message's sent date. In many cases, the DateLastModified on the attachments will be the Sent date anyway. A macro using the SentOn field is here.

The first macro saves the attachments on selected messages and changes the names of the saved files to include the modified date. The second macro is used as the script in a rule a script rule.

The macros save the attachments to the user's Documents folder.

## Use with selected messages

Public Sub saveAttachtoDisk()
Dim itm As Outlook.MailItem
Dim currentExplorer As Explorer
Dim Selection As Selection

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName

Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\Documents\Attachments\"

Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each itm In Selection

For Each objAtt In itm.Attachments

file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file

'Get the file name
Set oldName = fso.GetFile(file)

DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
newName = DateFormat & objAtt.DisplayName

oldName.Name = newName

Set objAtt = Nothing
Next

Next

Set fso = Nothing
End Sub


## Use in a Run a Script Rule

Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName

Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\Documents\test\"

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next

For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file

Set oldName = fso.GetFile(file)
DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
newName = DateFormat & objAtt.DisplayName
oldName.Name = newName

Set objAtt = Nothing
Next

Set fso = Nothing
End Sub


How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor

1. Venu says

Macro works fine, but I wanted to save the attachment with subject and sendername also along with date stamp. Subject line can be limited upto first 15 characters if its too long.

• Diane Poremsky says

Not a problem, you need to use something like
newName = left(itm.subject,15) & itm.sndername & dateformat

2. Perry Garrod says

Hi
I'd like to have my saved attachements, which I split out from the email, to have the same date - or within seconds - of the saved mail.
The attachments I am saving are scanned and them emailed, so it would be nice to be able to see then next to each other in the directory, but the scanned attachments have the scan date & time.
Is it posssible to save an attachment with either modified or create dates being the date the attachment is actually saved, i.e. same time as the email itself?
Doing this in VBSO VB
Thanks
Perry

• Diane Poremsky says

You can change the attachment name - if you want to use the time you saved it, the value would be Now (or Now()).

3. Warren Cramton says

I've tried making the suggested change so that it renames the attachment to the email Subject line but I'm not having any luck getting it to work.

I am an absolute novice at this. Any chance you can edit the first Macro to the exact content I need? The PDF attachment needs to be saved to C:\Temp and renamed to the Subject line of the message.

This is for Outlook 2013. Thanks in advance.

• April says

Hi Warren,

I know it's almost been a year and I'm on the same boat right now. Were you able to get the issue resolved? Hope you can share it with me.

Thanks.

4. Ganesh says

Very good it works perfectly from outlook.

After saving the attachment with date and time stamp, I want send this saved file to new address with subject "New mail".

Please can you help me on that ?

• Diane Poremsky says

Assuming you do it immediately, you just need to create a new message and use attachments.add (file) - you'll have the path to the file from saving it. (if you rename the file after saving, the path should be savefolder & newname instead of file)
Code sample here: http://www.slipstick.com/developer/create-a-new-message-using-vba/

5. April says

I'm stuck and need your expertise. I've use the script below to save the email attachment to a local drive but would like to replace the file name with the subject line.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\attached"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

• April says

Thank you for your generosity and for sharing your knowledge Diane. I tried to copy the code you provided to strip the illegal characters to my existing one above. It appears it cannot be combined, do i have to do it in a separate module,if yes, how do I run the macros to perform 2 tasks at the same time? Sorry, very little knowledge with VB.
Also, is it possible to just run the code for specific sender only?

• Diane Poremsky says

Get the ReplaceCharsForFileName function from that page - i like to put it in a new module with any other functions as it can be shared with other macros - then in the macro you are using, after you get the file name that needs illegal characters removed, add this line, where sName is the variable you used for the filename (you can change sName to whatever you need) - or you can use sName = itm.subject then use file = saveFolder & sName

ReplaceCharsForFileName sName, "-"

6. Jeff says

I successfully used the "run a script" version to a folde, but not a network drive..,, does VB need more lines of
Code to save to a network drive????

• Diane Poremsky says

saveFolder = "\\servername\path\to\folder" should work for the path as long as you have permission to write to the folder.

What happens when you try? Any error messages? Anything in the event viewer?

• Jeff Sims says

No, error messages, Nothing in Event logs...

7. Jeff says

...and is there an "IF" statement I can add to the code that can help me filter in "Excel" files to the drive/folder

• Diane Poremsky says

The code at the end of this article shows how to save based on file extension.
http://www.slipstick.com/developer/save-attachments-to-the-hard-drive/

something like this:
Select Case sFileType
Case ".jpg", ".png", ".gif"
saveto = "\Pictures\"
Case "xlsx"
saveto = "\Excel\"
case "docx"
saveto = "\Documents\"
End Select
saveFolder = enviro & saveto

8. jeffvts says

Thanks, I tried running the section of code by itself and incorporated into the "Run a script" code as well, but seemed to not work completely.... How would you use it or insert it? here's how I used it...

Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName

Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\\SIMS1\"

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next

For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file

Set oldName = fso.GetFile(file)
DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
newName = DateFormat & objAtt.DisplayName
oldName.Name = newName

Set objAtt = Nothing
Next

Set fso = Nothing

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

End Sub

Sub SaveToDisk()

End Sub

• Diane Poremsky says

You need to the select case code up where you are working with the attachments (and use the correct object names).

[top snipped]
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For i = itm.Attachments.count To 1 Step -1
strFile = itm.Attachments.item(i).FileName
' This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(strFile, 4))
Select Case sFileType