Solved

delete files based on age in vba

Posted on 2011-02-28
7
696 Views
Last Modified: 2012-05-11
I want to delete files that are more than  two years old.  The file name is PSBWIRE20110228.xlsm.   Date stamp was inserted on save with the "yyyymmdd" format.
The two years could be based on the year or number of days.  The deletion time is arbitrary and the code should allow me to easily change duration of time of deletion.  THX rgds/ron
0
Comment
Question by:1r3o2n8
7 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Is this what you want? Before you run it on a folder, make a backup of that folder as this code will delete the files which matches the criteria.

Const FilesPath As String = "C:\Temp\"

Sub Sample()
    Dim Ret As String, strCurrentFile As String
    
    Ret = MsgBox("Would you like to enter number of Years or Number of Days as deletion criteria?" & vbCrLf & _
    "Press 'Yes' for Years and 'No' for Days", vbYesNoCancel, "Deleteion Criteria")
    
    Select Case Ret
    
    Case vbYes
        Ret = InputBox("Please enter number of years", "Number of Years")
        
        strCurrentFile = Dir(FilesPath & "*.*")
        Do While strCurrentFile <> ""
            If Year(Now) - Year(FileLastModified(FilesPath & strCurrentFile)) > Ret - 1 Then
                Kill (FilesPath & strCurrentFile)
            End If
            strCurrentFile = Dir
        Loop
    Case vbNo
        Ret = InputBox("Please enter number of Days", "Number of Days")
        
        strCurrentFile = Dir(FilesPath & "*.*")
        Do While strCurrentFile <> ""
            If DateDiff("D", FileLastModified(FilesPath & strCurrentFile), Now) > Ret - 1 Then
                Kill (FilesPath & strCurrentFile)
            End If
            strCurrentFile = Dir
        Loop
    Case Else
        Exit Sub
    End Select
End Sub

Function FileLastModified(strFullFileName As String)
    Dim fs As Object, f As Object

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)

    FileLastModified = f.DateLastModified

    Set fs = Nothing: Set f = Nothing
End Function

Open in new window


Sid
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 125 total points
Comment Utility
In fact use this. I have commented the code and I have introduced Debug.Print so that you can check what files match the criteria. If the result is as expected then uncomment the line "Kill"

Sid

'~~> Change the path of the folder here
Const FilesPath As String = "C:\Temp\"

Sub Sample()
    Dim Ret As String, strCurrentFile As String
    
    Ret = MsgBox("Would you like to enter number of Years or Number of Days as deletion criteria?" & vbCrLf & _
    "Press 'Yes' for Years and 'No' for Days", vbYesNoCancel, "Deleteion Criteria")
    
    Select Case Ret
    
    '~~> For number of Years
    Case vbYes
        Ret = InputBox("Please enter number of years", "Number of Years")
        
        strCurrentFile = Dir(FilesPath & "*.*")
        Do While strCurrentFile <> ""
            If Year(Now) - Year(FileLastModified(FilesPath & strCurrentFile)) > Ret - 1 Then
                Debug.Print FilesPath & strCurrentFile
                'Kill (FilesPath & strCurrentFile)
            End If
            strCurrentFile = Dir
        Loop
    '~~> For number of Days
    Case vbNo
        Ret = InputBox("Please enter number of Days", "Number of Days")
        
        strCurrentFile = Dir(FilesPath & "*.*")
        Do While strCurrentFile <> ""
            If DateDiff("D", FileLastModified(FilesPath & strCurrentFile), Now) > Ret - 1 Then
                Debug.Print FilesPath & strCurrentFile
                'Kill (FilesPath & strCurrentFile)
            End If
            strCurrentFile = Dir
        Loop
    End Select
End Sub

'~~> Gets the Last saved/Modified Date of a file
Function FileLastModified(strFullFileName As String)
    Dim fs As Object, f As Object

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)

    FileLastModified = f.DateLastModified

    Set fs = Nothing: Set f = Nothing
End Function

Open in new window

0
 
LVL 10

Accepted Solution

by:
cdebel earned 250 total points
Comment Utility
Here's your code...
I'm not sure if the date format will be correct for every countries, so you might have change that line where i assign dDate to have a valid format.

Public Sub DeleteOldFiles()
    Dim aFile
    Dim sPath As String
    Dim sDate As String
    Dim dDate As Date
    Dim dLimit As Date
    
    sPath = "C:\TEMP"
    aFile = Dir(sPath & "\*.xlsm")
    While aFile <> ""
        sDate = Mid(aFile, 8, 8)
        dDate = Left(sDate, 4) & "-" & Mid(sDate, 5, 2) & "-" & Right(sDate, 2)
        
        ' Change your duration here.  Y for Year
        dLimit = DateAdd("yyyy", -2, Now)
        
        If dDate < dLimit Then
            Kill sPath & "\" & aFile
        End If
        
        aFile = Dir
    Wend
End Sub

Open in new window

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 10

Expert Comment

by:cdebel
Comment Utility
Oops sorry, didn't noticed that someone answered.

Well the big difference between our versions is that Sid's version check for the real time stamp (the last modification), and mine is based on the time stamp that you have placed in the file name.  

i've not analysed Sid version throughfuly but it should work too
0
 
LVL 12

Assisted Solution

by:sdwalker
sdwalker earned 125 total points
Comment Utility
I understood you to want the date check to occur on the filename rather than the last time it was modified, so I've modified Siddarth's code to use this instead.

I agree with Siddarth ... good idea to verify that the files you want deleted are listed in the immediate window (Debug.print statements) before running the code.  There's no undoing it here.

Good luck,

sdwalker
'~~> Change the path of the folder here
Const FilesPath As String = "C:\Temp\"

Sub test()

    Ret = MsgBox("Would you like to enter number of Years or Number of Days as deletion criteria?" & vbCrLf & _
    "Press 'Yes' for Years and 'No' for Days", vbYesNoCancel, "Deleteion Criteria")
    
    Select Case Ret
    
    '~~> For number of Years
    Case vbYes
        numYrs = InputBox("Please enter number of years", "Number of Years")
        myKeepDate = DateAdd("d", -numYrs, Date)
        
    '~~> For number of Days
    Case vbNo
        numDays = InputBox("Please enter number of Days", "Number of Days")
        myKeepDate = DateAdd("d", -numDays, Date)
        
    End Select
  strCurrentFile = Dir(FilesPath & "*.xlsm")
    
  Do While strCurrentFile <> ""
  
    'Assuming date always shows up right after PSBWIRE and always of yyyymmdd format
    
    If InStr(1, strCurrentFile, "PSBWIRE") Then
      strDate = Mid(strCurrentFile, 8, 8)
      
      varDate = CDate(Mid(strDate, 5, 2) & "/" & Right(strDate, 2) & "/" & Left(strDate, 4))
    
      If varDate < myKeepDate Then
    
        Debug.Print FilesPath & strCurrentFile
        'Kill (FilesPath & strCurrentFile)
        
      End If
      
    End If
    
    strCurrentFile = Dir
    
  Loop


End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:cdebel
Comment Utility
One little comment about my solution, we should change line 9 for this:
    aFile = Dir(sPath & "\PSBWIRE*.xlsm")

Also, the date format that i use here is yyyy-mm-dd.  So if you use a different date format, you might have to change line 12 for something more appropriate like this (if you use dd/mm/yyyy)
     dDate = Right(sDate, 2) &  "/" & Mid(sDate, 5, 2) & "/" & Left(sDate, 4)
0
 

Author Closing Comment

by:1r3o2n8
Comment Utility
All solutions were good, but cdebel was btrief and concise, so he/she got more points.  Thanks to all who responed quickly
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now