Renomear Arquivos com VBA Excel

Objetivo: Apresentar um código VBA para renomear arquivos utilizando VBA.

Este procedimento tem por função renomear todos os arquivos de uma pasta com um nome e um número sequencial.

Ao clicar no botão Renomear Arquivos a primeira solicitação é o local dos arquivos que quer renomear:

É muito importante que você determine corretamente a pasta, dado que todos os arquivos desta pasta serão renomeados. Cuidado.

O próximo passo é digitar qual o nome que precederá o número sequencial, no caso escolhemos a palavra Mês.

Abaixo o código VBA:

'Seleciona os arquivos
Public Sub lsSelecionaArquivo()
    Dim Caminho As String
    Dim NomeBase As String
    
    Caminho = InputBox("Informe o local dos arquivos a serem renomeados:", "Pasta", "C:\TEMP")
    NomeBase = InputBox("Informe o local dos arquivos a serem renomeados:", "Renomear", "")
    
    'Chama a função para renomear os arquivos
    lsRenomearArquivos Caminho, NomeBase
End Sub
 
'Função que renomea os arquivos
Public Sub lsRenomearArquivos(Caminho As String, NomeBase As String)
 
    Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
    Dim Linha As Long
    Dim lSeq As Long
    Dim lNovoNome As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(Caminho) Then
        MsgBox "A pasta '" & Caminho & "' não existe.", vbCritical, "Erro"
        Exit Sub
    End If

    lSeq = 1

    Set Pasta = FSO.GetFolder(Caminho)
    Set Arquivos = Pasta.Files
    
    Cells(1, 1) = "De"
    Cells(1, 2) = "Para"

    Linha = 2

    For Each Arquivo In Arquivos

        Cells(Linha, 1) = UCase$(Arquivo.Path)
        lNovoNome = Caminho & "\" & NomeBase & lSeq & Right(Arquivo, 4)
        Name Arquivo.Path As lNovoNome

        Cells(Linha, 2) = lNovoNome
        lSeq = lSeq + 1
        Linha = Linha + 1

    Next
End Sub

Abraço

Marcos Rieper