sequentially rename multiple files within specific subfolders

[CaptainKen]

I found this post that seems similar to what I need to do, but not quit what I need.

vba to rename files in folders, subfolders and sub-subfolders

Hi, I have the code below that does a good job of renaming folders but it only renames one subfolder down in the folder '2023 Test' and I need it to rename files in all the sub-subfolders where they occur. As you can see I currently specify the folder name in cell D4 then run the code and have...

www.mrexcel.com

I have a list of numerous folders in Excel such as the example below, where I need to rename files using prefix "fanart" with suffix of sequential numbers within each respective "extrafanart" folder. Within each fanart folder the numbering would start from zero. So file names: fanart1.jpg, fanart2.jpg, etc.

Video\Movies\A Million Ways to Die in the West (2014)\extrafanart
Video\Movies 4K\Black Panther - Wakanda Forever (2022)\extrafanart
Video\Movies\Movie Sets\American Pie Collection\American Pie 1 (1999)\extrafanart
Video\Movies\Movie Sets\American Pie Collection\American Pie 2 (2001)\extrafanart
Video\Movies\Movie Sets\American Pie Collection\American Pie 3 American Wedding (2003)\extrafanart
Video\Movies\Movie Sets\American Pie Collection\American Pie Presents Band Camp (2005)\extrafanart
Video\Movies\Movie Sets\American Pie Collection\American Pie Presents Beta House (2007)\extrafanart

As you can see in the above examples the files to be sequentially renamed will always be in a folder called "extrafanart".

 

[John_w]

Try this macro, after changing the folder path string to the location of your "\Video\" folder and it will rename all the files in all the subfolders of "\Video\" which end with "\extrafanart".

To test it on just one folder, specify the folder string "C:\path\to\Video\Movies\A Million Ways to Die in the West (2014)\", for example.

Public Sub Rename_Files_In_Folders()       
    Rename_Files_In_Folder "C:\path\to\Video\"            'CHANGE THIS FOLDER PATH  
    MsgBox "Done" 
End Sub


Private Sub Rename_Files_In_Folder(folderPath As String)

    Static FSO As Object
    Dim thisFolder As Object, subfolder As Object
    Dim thisFile As Object
    Dim p As Long, n As Long
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set thisFolder = FSO.GetFolder(folderPath)
        
    If InStrRev(thisFolder.Path, "\extrafanart", -1, vbTextCompare) = Len(thisFolder.Path) - Len("\extrafanart") + 1 Then
        'This folder path ends with "\extrafanart", so rename the files in it
        n = 0
        For Each thisFile In thisFolder.Files
            p = InStrRev(thisFile.Name, ".")
            If p > 0 Then
                n = n + 1
                thisFile.Move thisFile.ParentFolder & "\fanart" & n & Mid(thisFile.Name, p)
            End If
        Next
    End If
    
    'Do subfolders
    
    For Each subfolder In thisFolder.SubFolders
        Rename_Files_In_Folder subfolder.Path
    Next
    
End Sub

 

[CaptainKen]

Thanks you John!

I copied and pasted this into a vbs file and changed the path, but I'm getting the error shown here.

It's pointing to the "A" in As within this line
Private Sub Rename_Files_In_Folder(folderPath As String)

 

[John_w]

The code is VBA, not VBScript, and should be copied and pasted into a module in an Excel workbook, saved as a macro-enabled workbook (.xlsm file).

 

[CaptainKen]

Awesome thank you that worked perfectly!!