Excel Erro no código vba para preservar os dois arquivos recentes.

[GENECIOFICIAL]

Bom dia!

Solicito a sua ajuda para resolver o problema.

Postei a dúvida aqui no fórum e responderam-me com o código para excluir todos os arquivos da pasta, preservando apenas os 2 arquivos recentes.

Porém o código apresentou conforme a imagem.

 

Grato - Geneci.

 

 

Sub PRESERVAOSDOISULTIMOSARQUIVOS()

'

' Sub ManterArquivosMaisRecentes()

    Dim Pasta As String

    Dim Arquivos() As String

    Dim Arq As String

    Dim DataArq As Date

    Dim i As Long

   

    ' Especifique o diretório onde estão os arquivos

    Pasta = "E:\DADOS\VBA "

   

    ' Lista todos os arquivos no diretório

    ' Arquivos = VBA.FileSystem.Dir(Pasta)

   

    ' Inicializa a data mais recente como uma data muito antiga

    DataArq = DateSerial(1900, 1, 1)

        

        ' Extrai a data do nome do arquivo

        DataArquivo = CDate(Mid(Arq, InStrRev(Arq, "-") + 2))

       

        ' Verifica se a data do arquivo atual é maior que a data mais recente encontrada até agora

        If DataArquivo > DataArq Then

            DataArq = DataArquivo

        End If

     Next i

   

    ' Loop novamente para excluir os arquivos mais antigos

    For i = LBound(Arquivos) To UBound(Arquivos)

        Arq = Arquivos(i)

        DataArquivo = CDate(Mid(Arq, InStrRev(Arq, "-") + 2))

       

        ' Verifica se a data do arquivo é diferente da data mais recente

        If DataArquivo <> DataArq Then

            ' Exclui o arquivo

            VBA.FileSystem.Kill Pasta & Arq

        End If

    Next i

End Sub