Este fórum está sendo desativado

[GENECI]

Bom dia!
Solicito a sua ajuda, para excluir através do VBA os arquivos anteriores, permanecendo apenas os 2 arquivos recentes.

Grato - Geneci.

[AfonsoMira]

Boas,

Experimente a seguinte MACRO VBA.

Vai eliminar todos os ficheiros de uma pasta exepto os dois ficheiros mais recentes, pode adaptar para você.

Código: Selecionar todos

Sub ManterApenasDoisArquivosMaisRecentes()

    Dim pasta As String
    Dim arquivos() As String
    Dim i As Integer
    Dim dataCriacao() As Variant
    Dim arqInfo As Object
    
    ' Defina o caminho da pasta onde os arquivos são salvos
    pasta = "INSERIR CAMINHO DA PASTA"
    
    ' Lista todos os arquivos na pasta
    arquivos = Split(CreateObject("WScript.Shell").Exec("cmd /c dir """ & pasta & """ /s /b /o:gn").StdOut.ReadAll, vbCrLf)
    
    ' Inicializa um array para armazenar a data de criação de cada arquivo
    ReDim dataCriacao(1 To UBound(arquivos) + 1)
    
    ' Cria um objeto para obter informações sobre os arquivos
    Set arqInfo = CreateObject("Scripting.FileSystemObject")
    
    ' Preenche o array de data de criação
    For i = 1 To UBound(arquivos)
        dataCriacao(i) = arqInfo.GetFile(arquivos(i - 1)).DateCreated
    Next i
    
    ' Classifica os arquivos com base na data de criação (mais recente primeiro)
    For i = 1 To UBound(dataCriacao)
        For j = i + 1 To UBound(dataCriacao)
            If dataCriacao(i) < dataCriacao(j) Then
                ' Troca de posição na lista
                Swap arquivos, i, j
                Swap dataCriacao, i, j
            End If
        Next j
    Next i
    
    ' Mantém apenas os dois arquivos mais recentes
    For i = 3 To UBound(arquivos)
        Kill arquivos(i - 1)
    Next i

End Sub

Sub Swap(ByRef arr As Variant, ByVal index1 As Integer, ByVal index2 As Integer)
    ' Função auxiliar para trocar elementos de posição em um array
    Dim temp As String
    temp = arr(index1)
    arr(index1) = arr(index2)
    arr(index2) = temp
End Sub