[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

delete files based on age in vba

Posted on 2011-02-28
7
Medium Priority
?
794 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 500 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:
Christian de Bellefeuille earned 1000 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
Prepare for your VMware VCP6-DCV exam.

Josh Coen and Jason Langer have prepared the latest edition of VCP study guide. Both authors have been working in the IT field for more than a decade, and both hold VMware certifications. This 163-page guide covers all 10 of the exam blueprint sections.

 
LVL 10

Expert Comment

by:Christian de Bellefeuille
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 500 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:Christian de Bellefeuille
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Having trouble getting your hands on Dynamics 365 Field Service or Project Service trial? Worry No More!!!
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

829 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