Guru do Excel + Power BI

Sua dose diária de Power BI e Excel

Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
  • Avatar do usuário
#73812
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

Connect casually with like-minded individuals on t[…]

Unlock a world of casual fun and excitement with t[…]

Connect casually with like-minded individuals on t[…]

Fiz o uso dessa macro por muito tempo, mas agora e[…]

Fórmula Soma com Condições

Salve, Jorge. A função SOMARPRODUTO[…]

Basicamente, preciso selecionar todo o campo at&[…]

Make dating stress-free and enjoyable with the bes[…]

Connect casually with like-minded individuals on t[…]