Excel Excluir todos os arquivos exceto os dois últimos por critério de data

[GENECIOFICIAL]

Boa tarde!

É possível elaborar um código vba, para excluir todos os arquivos e deixá-los apenas os dois arquivos com as datas mais recentes.

Exemplo Tenho os arquivos: Código rev 1 - 17-10-2023        Código rev 2 - 18-10-2023        Código rev 3 - 19-10-2023       Código rev 4 - 20-10-2023                          Código rev - 5  19-10-2023

 

A macro vai deixar apenas os 2 arquivos: Código rev 4 - 20-10-2023   Código rev - 5  19-10-2023

 

Grato.

[Dnzx]

2 horas atrás, GENECIOFICIAL disse:

Boa tarde!

É possível elaborar um código vba, para excluir todos os arquivos e deixá-los apenas os dois arquivos com as datas mais recentes.

Exemplo Tenho os arquivos: Código rev 1 - 17-10-2023        Código rev 2 - 18-10-2023        Código rev 3 - 19-10-2023       Código rev 4 - 20-10-2023                          Código rev - 5  19-10-2023

 

A macro vai deixar apenas os 2 arquivos: Código rev 4 - 20-10-2023   Código rev - 5  19-10-2023

 

Grato.

 

Você pode usar VBA (Visual Basic for Applications) no Excel para criar um código que exclua automaticamente os arquivos mais antigos, mantendo apenas os dois mais recentes em um determinado diretório. Aqui está um exemplo de código VBA que faz isso:

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 = "C:\Caminho\Para\O\Seu\Diretório\"
    
    ' 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)
    
    ' Loop através dos arquivos no diretório
    For i = LBound(Arquivos) To UBound(Arquivos)
        Arq = Arquivos(i)
        
        ' 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

 

[GENECIOFICIAL]

Muito obrigado por elaborar o código VBA, em atenção a solicitação, que resolve o problema.

Desculpe por explorar a sua boa vontade e os sólidos conhecimentos.

 

Considerando que um arquivo é salvo através de macro, e cada vez que é salvo gera um novo arquivo adicionando um numerador, acumulando vários arquivos.

 

Pode ajustar o código VBA, para excluir todos os arquivos através do nome do arquivo, porém com o final diferente?

Exemplo: Tenho os arquivos.

Código rev 1

Código rev 2

Código rev 3

Código rev 4

Código rev 5

Código rev 6

Código rev 7

A macro vai preservar apenas os arquivos:  Código rev 6

Código rev 7

Ou o código anterior atende a necessidade?

 

Grato por dispor dos seus conhecimentos.