Solved

delete files based on age in vba

Posted on 2011-02-28
7
719 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
ID: 35000720
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
ID: 35000761
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
ID: 35000845
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
Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 
LVL 10

Expert Comment

by:cdebel
ID: 35000867
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
ID: 35000930
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
ID: 35001008
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
ID: 35031297
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

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The new Microsoft OS looks great, is easier than ever to upgrade to, it is even free.  So what's the catch?  If you don't change the privacy settings, Microsoft will, in accordance with the (EULA) you clicked okay to without reading, collect all the…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

777 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