Файлы счетчика Excel VBA, последний раз измененные до даты

Я ищу код, который подсчитывает количество файлов в определенной папке, у которых есть конкретная дата последнего изменения: сегодня - 90.

Я разработал код для подсчета ВСЕХ файлов в папке (что является частью того, что я хочу), но застрял в подсчете, когда файлы стареют.

Любые предложения приветствуются!

Sub CountFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Set the paths
Dim PathEvaluations As String
Dim PathPDF As String
Dim PathA As String
Dim PathB As String

Dim CountEvaluations As Integer
Dim CountOldEvals As Integer
Dim CountPDF As Integer
Dim CountOldPDF As Integer

Dim MsgBoxTitle As String
Dim PurgeDate As Date

PathEvaluations = Worksheets("References").Range("B50").Value
PathPDF = Worksheets("References").Range("B51").Value
MsgBoxTitle = Worksheets("References").Range("B32").Value
PurgeDate = Worksheets("References").Range("B77").Value

    PathA = PathEvaluations & "*.xlsx"
    Filename = Dir(PathA)

    Do While Filename <> ""
        CountEvaluations = CountEvaluations + 1
        Filename = Dir()
    Loop

    PathB = PathPDF & "*.pdf"
    Filename = Dir(PathB)

    Do While Filename <> ""
        CountPDF = CountPDF + 1
        Filename = Dir()
    Loop

MsgBox "System maintenance:" & vbNewLine & vbNewLine & _
    CountEvaluations & " files found in: evaluations folder" & vbNewLine & _
    "of which " & CountOldEvals & " are from before: " & PurgeDate & " and can be deleted!" & vbNewLine & vbNewLine & _
    CountPDF & " files found in: pdf folder" & vbNewLine & _
    "of which " & CountOldPDF & " are from before: " & PurgeDate & " and can be deleted!", vbInformation, MsgBoxTitle


End Sub

file excel count vba last-modified
person Chis.Wisselo    schedule 24.10.2015    source источник
comment
Можете ли вы использовать FileDateTime (FILEPATH)? Это должно вернуть дату и время в часовом поясе локального ПК, когда он был создан / последний раз изменен.   -  person Lima    schedule 24.10.2015

Ответы (1)


arrow_upward
0
arrow_downward

Что-то вроде следующего должно работать:

Dim FileDate As Date
Dim Minus90 As Date
Minus90 = DateAdd("d", -90, Date)

PathA = PathEvaluations & "*.xlsx"
    Filename = Dir(PathA)


    Do While Filename <> ""
        CountEvaluations = CountEvaluations + 1
        FileDate = FileDateTime(PathEvaluations & Filename)
        If FileDate <= Minus90 Then
        CountOldEvals = CountOldEvals + 1
        End If

        MsgBox (FileDate)
        Filename = Dir()
    Loop
person Lima    schedule 24.10.2015