Зациклите в папке и удалите .xlsm файл VBA

Question

Уважаемые,

Я создаю код для циклического перемещения по папке и удаления файлов, которым 10 лет, но цикл не работает должным образом, поскольку FolderPath (переменная) остается неизменной, а цикл следует бесконечномуloop.any помощь?

Sub LoopThroughFolder()

Dim FolderPath As String

FolderPath = Dir("C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\*.xlsm")

 Do While FolderPath <> ""
    If DateValue( _
                    Mid(FolderPath, InStr(FolderPath, ".") + 1, 2) & "/" & _
                    Mid(FolderPath, InStr(FolderPath, ".") + 3, 2) & "/" & _
                    Mid(FolderPath, InStr(FolderPath, ".") + 5, 4)) _
        < DateValue(Date - 10) Then

        Application.DisplayAlerts = False
            SetAttr "C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\" & FolderPath, vbNormal
            Kill "C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\" & FolderPath
        Application.DisplayAlerts = True

        FolderPath = Dir

    End If
Loop

End Sub

Answer 1

Вам нужно переместить FolderPath = Dir, в настоящее время он находится внутри оператора IF, что означает, что он будет искать следующий файл, только если текущий файл старше 10 дней.

Sub LoopThroughFolder()

Dim FolderPath As String

FolderPath = Dir("C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\*.xlsm")

 Do While FolderPath <> ""
    If DateValue( _
                    Mid(FolderPath, InStr(FolderPath, ".") + 1, 2) & "/" & _
                    Mid(FolderPath, InStr(FolderPath, ".") + 3, 2) & "/" & _
                    Mid(FolderPath, InStr(FolderPath, ".") + 5, 4)) _
        < DateValue(Date - 10) Then

        Application.DisplayAlerts = False
            SetAttr "C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\" & FolderPath, vbNormal
            Kill "C:\Users\XXXX\XXXX\XXXX\XXXX\XXXX\" & FolderPath
        Application.DisplayAlerts = True
    End If
  FolderPath = Dir
Loop

End Sub