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.
Save attachments with the modified date

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


Comments

  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 ?

  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

    Thank you in advance.

    • 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 PoremskyDiane 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 PoremskyDiane 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?

  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

  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
    ' Add additional file types below
    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 PoremskyDiane 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
      ' Add additional file types below
      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. File = saveFolder & strFile ' objAtt.SaveAsFile file nexti: Next i 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

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.