- 28 Nov 2023 às 15:00
#73819
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
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