Página 1 de 1

Apagar todos os arquivos e preservar os 2 recentes.

Enviado: 28 Nov 2023 às 15:00
por GENECI
Boa tarde!

Solicito a sua ajuda para resolver o problema.

O código da macro apaga os arquivos da pasta, preservando apenas os 2 arquivos recentes.

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



Grato - Geneci.





Sub PRESERVAOSDOISULTIMOSARQUIVOS()
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
Imagem

Re: Apagar todos os arquivos e preservar os 2 recentes.

Enviado: 29 Nov 2023 às 05:56
por AfonsoMira
Boas,

A resposta a este Tópico não resolve o seu problema ?
APAGAR OS ARQUIVOS E DEIXAR APENAS OS DOIS ARQUIVOS MAIS RECENTES.

Re: Apagar todos os arquivos e preservar os 2 recentes.

Enviado: 29 Nov 2023 às 12:27
por GENECI
Boa tarde!
Muito obrigado, por dispor dos seus conhecimentos para resolver o meu problema.
Inseri o código em um módulo e ajustei a minha necessidade, porém apresentou erro.
Por favor, pode verificar.

Grato - Geneci.

Re: Apagar todos os arquivos e preservar os 2 recentes.

Enviado: 04 Dez 2023 às 16:42
por GENECI
Boa tarde!
Por favor, pode instalar o código no arquivo e dispor, não consegui resolver o problema.

Grato.