Rename multiple files in a folder with a macro

Hi,

I have multiple files in a folder and I want to rename them automatically via a macro. I use Excel 2016.

BEFORE

The existing file names are:

Firstname Surname.html
OR
Firstname Surname SOMETEXT.html
OR
Firstname Surname SOMETEXT_SOMETEXT.html

AFTER

I would like the macro to rename the files to:

Firstname Surname _ Live.html
or
Firstname Surname SOMETEXT_SOMETEXT_Live.html

Can you help me with this request?

Thank you,
Ash

Add this code to a standard codemodule in the .xlsm file, and set a reference to MS Scripting Runtime. Save the workbook in the folder with all the html files to be renamed prior to running the macro. Of course, change SOMETEXT to the actual text that you have - if it isn't the same for all files, delete the first Name line and uncomment the second.

Sub RenameFiles()
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(ThisWorkbook.path)

    For Each objFile In objFolder.Items
        If objFile.Name Like "*.html" Then
 
           Name objFile.Name As Replace( Replace( objFile.Name, "SOMETEXT", ""), ".html", "_Live.html")
           'Name objFile.Name As Replace( objFile.Name,  ".html", "_Live.html")

        End If
    Next objFile
    
End Sub

Try the following .. Put your files in a folder named "Test Folder" in the same path of thisworkbook

Sub Rename_Files()
    Dim fls     As Variant
    Dim f       As Variant

    Set fls = GetFiles(ThisWorkbook.Path & "\Test Folder\", "*.html")
    
    For Each f In fls
        Name f As Replace(f, ".html", "_Live.html")
    Next f
    
    MsgBox "Done...", 64
End Sub

Function GetFiles(strPath As String, Optional strPattern As String = "") As Collection
    Dim rv      As New Collection
    Dim f       As Variant

    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    f = Dir(strPath & strPattern)

    Do While Len(f) > 0
        rv.Add strPath & f
        f = Dir()
    Loop

    Set GetFiles = rv
End Function

Did you save the workbook in the same folder? I used Book2.xlsm:

Capture.JPG

Capture after.JPG

Sub RenameFiles()
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(ThisWorkbook.Path)

    For Each objFile In objFolder.Items
        If objFile.Name Like "*.html" Then
 
           Name objFile.Name As Replace(objFile.Name, ".html", "_Live.html")

        End If
    Next objFile
    
End Sub

This code requires a reference to MS Scripting Runtime - place the Excel Workbook in the root folder, and all the HTML files will be renamed:

Option Explicit
Dim FSO As Scripting.FileSystemObject
Sub RenameAllHTMLFilesInFolderTree()
    Dim strFolderName As String
    Dim fsoFolder As Scripting.Folder
    
    If FSO Is Nothing Then
        Set FSO = New Scripting.FileSystemObject
    End If
        
    strFolderName = ThisWorkbook.Path     'Change to your actual folder
    Set fsoFolder = FSO.GetFolder(strFolderName)
    FindAndRenameFiles fsoFolder
    
End Sub

Sub FindAndRenameFiles(fsoPFolder As Scripting.Folder)
    Dim fsoFile As Scripting.File
    Dim fsoSFolder As Scripting.Folder
        
    For Each fsoFile In fsoPFolder.Files
        If LCase(fsoFile.Name) Like "*.html" Then
            Name fsoPFolder.Path & "\" & fsoFile.Name As Replace(fsoPFolder.Path & "\" & fsoFile.Name, ".html", "_Live.html")
        End If
    Next fsoFile
    
    For Each fsoSFolder In fsoPFolder.SubFolders
        FindAndRenameFiles fsoSFolder
    Next fsoSFolder
    
End Sub

Ok - take a look over there, too.

I am getting an error in the macro.

The error happens when there are special chars in file names:
Matt Taylor ☁
Александр БойкO
Андрей ОконникоB
Виталий ЩербаньA

Plus there could be other special chars, etc.

Please advise?

My system doesn't allow special characters, so I cannot test it. You should start a new thread to ask about that.