access vba to delete excel files older than 7 working days

Try the following:

Public DeleteOldFiles(byval folderPath as string)
    Dim fso as Object    '// Scripting.FileSystemObject
    Set fso = createObject("Scripting.FileSystemObject")

    Dim fld as Object    '// Scripting.Folder
    Set fld = fso.GetFolder(folderPath)

    Dim fl as Object    '// Scripting.File
    For Each fl In fld.files
        If(fld.GetExtentionName(fl.Name) like "xls*") Then
            If(fl.DateLastModified < DateAdd("d", -7, DateSerial(year(now), month(now), day(now)))
                fso.DeleteFile fl.Path
            End If
        End If
    Next
End Sub

Select allOpen in new window

Hi Fabrice,

Thanks for your interest. Please find the file attached.  Can you please correct this for me.

Thank you
A
error.jpg

Also, please note that the vba code should be able to delete excel files older 7 working days.

Will it have to take holydays into consideration ?
How do you intend to call the procedure ? As I designed it, there is no need to hard code the path.

To skip the weekend (and ignore holidays), you could simply deduct 9 calendar days to obtain 7 working days - and reduce it a little:

        If(fld.GetExtentionName(fl.Name) like "xls*") Then
            If DateDiff("d", fl.DateLastModified, Date) > 9 Then
                fso.DeleteFile fl.Path
            End If
        End If

Select allOpen in new window

Hi Fabrice,

Thank you for your query. Please exclude weekends as well as holidays.

Thank you
A

Also Fabrice, I need to give the path to the files on VBA script

H Gustav, thanks for you input.

In excel there is  functions like workday() and networkdays() to calculate working days. I thought if something like that can be included in the vba code that would great.

Thank you
A

Hi Gustav/Fabrice,

For the time being, we can ignore holidays. Can we create a vba code to delete excel files older than 7 working days, based on the workday() function in excel.

Gustav, Monday morning when they look for last 7 working days reports, your logic does not work it seems

Thanks

You can use the function(s) below to adjust your code to:

        If(fld.GetExtentionName(fl.Name) Like "*.xls*") Then
            If DateDiffWorkdays(fl.DateLastModified, Date) > 7 Then
                fso.DeleteFile fl.Path
            End If
        End If

Select allOpen in new window

Note the modification of the filter.

' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
'   Mo  Tu  We  Th  Fr  Sa  Su      Su  Sa  Fr  Th  We  Tu  Mo
'    0   1   2   3   4   4   4       0   0  -1  -2  -3  -4  -5
'
'   Su  Mo  Tu  We  Th  Fr  Sa      Sa  Fr  Th  We  Tu  Mo  Su
'    0   1   2   3   4   5   5       0  -1  -2  -3  -4  -5  -5
'
'   Sa  Su  Mo  Tu  We  Th  Fr      Fr  Th  We  Tu  Mo  Su  Sa
'    0   0   1   2   3   4   5       0  -1  -2  -3  -4  -4  -4
'
'   Fr  Sa  Su  Mo  Tu  We  Th      Th  We  Tu  Mo  Su  Sa  Fr
'    0   0   0   1   2   3   4       0  -1  -2  -3  -3  -3  -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Long
    
    Dim Holidays()      As Date
    
    Dim Diff            As Long
    Dim Sign            As Long
    Dim NextHoliday     As Long
    Dim LastHoliday     As Long
    
    Sign = Sgn(DateDiff("d", Date1, Date2))
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date2.
            Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
            ' Ignore error when using LBound and UBound on an unassigned array.
            On Error Resume Next
            NextHoliday = LBound(Holidays)
            LastHoliday = UBound(Holidays)
            ' If Err.Number > 0 there are no holidays between Date1 and Date2.
            If Err.Number > 0 Then
                WorkOnHolidays = True
            End If
            On Error GoTo 0
        End If
        
        ' Loop to sum up workdays.
        Do Until DateDiff("d", Date1, Date2) = 0
            Select Case Weekday(Date1)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    If WorkOnHolidays = False Then
                        ' Check for holidays to skip.
                        If NextHoliday <= LastHoliday Then
                            ' First, check if NextHoliday hasn't been advanced.
                            If NextHoliday < LastHoliday Then
                                If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
                                    ' Weekend hasn't advanced NextHoliday.
                                    NextHoliday = NextHoliday + 1
                                End If
                            End If
                            ' Then, check if Date1 has reached a holiday.
                            If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
                                ' This Date1 hits a holiday.
                                ' Subtract one day to neutralize the one
                                ' being added at the end of the loop.
                                Diff = Diff - Sign
                                ' Adjust to the next holiday to check.
                                NextHoliday = NextHoliday + 1
                            End If
                        End If
                    End If
                    Diff = Diff + Sign
            End Select
            ' Advance Date1.
            Date1 = DateAdd("d", Sign, Date1)
        Loop
    End If
    
    DateDiffWorkdays = Diff

End Function


' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal OrderDesc As Boolean) _
    As Date()
    
    ' Constants for the arrays.
    Const DimRecordCount    As Long = 2
    Const DimFieldOne       As Long = 0
    
    Static Date1Last        As Date
    Static Date2Last        As Date
    Static OrderLast        As Boolean
    Static DayRows          As Variant
    Static Days             As Long
    
    Dim rs                  As DAO.Recordset
    
    ' Cannot be declared Static.
    Dim Holidays()          As Date
    
    If DateDiff("d", Date1, Date1Last) <> 0 Or _
        DateDiff("d", Date2, Date2Last) <> 0 Or _
        OrderDesc <> OrderLast Then
        
        ' Retrieve new range of holidays.
        Set rs = DatesHoliday(Date1, Date2, OrderDesc)
        
        ' Save the current set of date parameters.
        Date1Last = Date1
        Date2Last = Date2
        OrderLast = OrderDesc
        
        Days = rs.RecordCount
            If Days > 0 Then
                ' As repeated calls may happen, do a movefirst.
                rs.MoveFirst
                DayRows = rs.GetRows(Days)
                ' rs is now positioned at the last record.
            End If
        rs.Close
    End If
    
    If Days = 0 Then
        ' Leave Holidays() as an unassigned array.
        Erase Holidays
    Else
        ' Fill array to return.
        ReDim Holidays(Days - 1)
        For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
            Holidays(Days) = DayRows(DimFieldOne, Days)
        Next
    End If
        
    Set rs = Nothing
    
    GetHolidays = Holidays()
    
End Function


' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal ReverseOrder As Boolean) _
    As DAO.Recordset
        
    ' The table that holds the holidays.
    Const Table         As String = "Holiday"
    ' The field of the table that holds the dates of the holidays.
    Const Field         As String = "Date"
    
    Dim rs              As DAO.Recordset
    
    Dim SQL             As String
    Dim SqlDate1        As String
    Dim SqlDate2        As String
    Dim Order           As String
    
    SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
    SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
    ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
    Order = IIf(ReverseOrder, "Desc", "Asc")
        
    SQL = "Select " & Field & " From " & Table & " " & _
        "Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
        "Order By 1 " & Order
        
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
        
    Set DatesHoliday = rs
    
End Function

Select allOpen in new window

If you have no holidays, you can exclude the holiday part.

Hmm,

I dunno much about foreign holydays, but in France, we have fixed days (such as Christmas, December 25th), and a couple of days based on easter day (wich can be computed).
Thus, it is possible to compute every holdays of a given year without requiring a table (annoying to update this one every year, and prone to errors or forgetfulness).

Hi Fabrice,

Please ignore holidays. Don't worry about that.

Thank you
A