Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

delete files based on age in vba

Posted on 2011-02-28
7
724 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
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

790 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