rename file names in a folder and files inside subfolders, vba

[ARobb4]

greetings,

as the title says, i'm trying to rename all files from a base path and files from its subfolders.

my code, so far,.. only renames files in the base folder..
and it has an error path/file access error...

Public Sub rFiles()Dim strPath As String
Dim lngCount As Long
Dim position As Integer
Dim fso As FileSystemObject
Dim file_ As File


path = Range("A2").Value
fv = Range("B2").Value
tv = Range("C2").Value


    strPath = path & "\"
    strFile = Dir(strPath & "*" & fv & "*")
    Set fso = New FileSystemObject


        If (Not (fso.FolderExists(path))) Then
        'the folder path is invalid. Exiting.
        MsgBox "Invalid Path"
        Exit Sub
        End If
        
        fileCounter = 1
        'Set activeSht = ActiveSheet
        
    
    Set baseFolder = fso.GetFolder(path)
    
    For Each file_ In baseFolder.Files


        position = InStrRev(strFile, ".")
        suffix = Right(strFile, Len(strFile) - (position - 1))
        
        Filename = Left(strFile, Len(strFile) - Len(suffix))
        newFilename = Replace(Filename, fv, tv)
        lngCount = lngCount + 1
        strName = newFilename & suffix
        Name strPath & strFile As strPath & strName
        strFile = Dir
     
    Next


End Sub

what it currently does is it renames all files in the base folder that has "14" and changes the "14" to "15" or whatever the variable's value is.
what needs to be done is to rename all the files including the ones inside the subfolders.

ex:
fv(from value)=14
tv(to value) =15

files on base folder (C:\Test\)

Luis14_OS.xls to Luis15_OS.xls
Bong14_OS.xls to Bong15_OS.txt
Gina14_OS.xls to Gina15_OS.docx
June14 (This is a folder)

inside june 14, (C:\Test\June14\)
Marcus14.iso to Marcus15.iso
ouch_14a.xlsm to ouch_15a.xlsm

Regards,
Thanks in advance! =)

 

[Skvba]

Thank you very much for your quick reply. I have to confess I don't know how to add a reference for scripting runtime.
Thank you again for your help.

 

[Skvba]

Okay, I figured out how to add a reference for scripting runtime. It works like a charm! Thank you!

 

[BrianMH]

Glad you got it sorted!

 

[Skvba]

Me too, Thanks again!

 

[dracoholikus]

Hello, i recently grabbed the code posted by @BrianMH and modified to rename some files based on a excel range, different from the OP request, this one loops through a list of names, find them in the folders and subfolders and rename.

It can be of some use to someone.

All it does now is this,

Based on a excel list,

D1 cell is the base path, as marked in code.

Range is marked in the code, i suggest changing the range when using the code, because i found that if you leave it very high it will result in some errors, probably because it's trying to replace empty cells values with empty cell values.

This routine was modified because i had many old files(~10000) with an outdated naming system, so i changed the naming system but found myself in some trouble.

If anyone can improve the code, i'll gladly appreciate it, like putting some mouse selecting range style.

Dim FS As FileSystemObject

Sub Renamer()
Dim i As Integer
Dim Folder As Scripting.Folder
Dim BasePath As String
Dim BCellArray As Range
Set BCellArray = Range("B2:B4") 'Change the cell range to stop overflowing, i think at least
Dim CCellArray As Range
Set CCellArray = Range("C2:C4") 'Change the cell range to stop overflowing, i think at least

If FS Is Nothing Then
    Set FS = New FileSystemObject
End If
BasePath = Range("D1")

If Not FS.FolderExists(BasePath) Then
    MsgBox "Folder doesn't Exist"
    Exit Sub
End If

    For i = 1 To BCellArray.Cells.Count
    Set Folder = FS.GetFolder(BasePath)
    RenameFile Folder, BCellArray.Cells(i).Value, CCellArray.Cells(i).Value
    Next
End Sub

Sub RenameFile(Folder As Scripting.Folder, OlderName As String, NewName As String)
    
    Dim File As File
    Dim StringName As String
    Dim StringFullName As String
    
    If FS Is Nothing Then
        Set FS = New FileSystemObject
    End If
    
    For Each File In Folder.Files
        If File.Name Like "*" & OlderName & "*" Then
                StringName = File.Name
                StringName = Replace(StringName, OlderName, NewName)
                StringFullName = File.ParentFolder & "\" & StringName
                Name File As StringFullName
        End If
    Next
    
    For Each Folder In Folder.SubFolders
        RenameFile Folder, OlderName, NewName
    Next
    
End Sub

 

[Josephchari]

You need to add a reference for scripting runtime.

Hi Brian,

I just dig the code. I tried to use it but just work for 1 row. May you help to advise how to work all lines? Please see the screenshot. Thank you!

Path	Originalfilename	Newfilename
a:\GOGO 5\TEST RENAME\105244 - Arkansas State_Replica Jersey Volleyball	LG_622_VOLLEYBALL_105244_ArkansasState_ReplicaJerseyVolleyball.pdf	1.pdf
a:\GOGO 5\TEST RENAME\99950 - North Texas - NCAA Women's Volleyball Black Jersey\Print FIles\	YXL_622_99950_NILAT_2023.pdf	2.pdf
a:\GOGO 5\TEST RENAME\102419 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	FONT__622_VOLLEYBALL_MD_102419_UTSA_Volleyball_TURNER_8.pdf	3.pdf
a:\GOGO 5\TEST RENAME\102423 - Hawaii - NCAA Women's Volleyball Black Jersey\	FONT__622_VOLLEYBALL_MD_102423_Hawaii_Black_LANE_2.pdf	4.pdf
a:\GOGO 5\TEST RENAME\104987 - Florida - NCAA Women's Volleyball White Fashion Jersey\	FONT__622_VOLLEYBALL_MD_104987_Florida_WhiteFashion_CORNIER_2.pdf	5.pdf
a:\GOGO 5\TEST RENAME\104987 - Florida - NCAA Women's Volleyball White Fashion Jersey\	FONT__622_VOLLEYBALL_SM_104987_Florida_WhiteFashion_CORNIER_2.pdf	6.pdf
a:\GOGO 5\TEST RENAME\102423 - Hawaii - NCAA Women's Volleyball Black Jersey\	FONT__622_VOLLEYBALL_LG_102423_Hawaii_Black_LANE_2.pdf	7.pdf
a:\GOGO 5\TEST RENAME\101587 - Boston College - NCAA Women's Volleyball White Jersey\	FONT__622_VOLLEYBALL_MD_101587_BostonCollege_White_SCHRODER_2.pdf	8.pdf
a:\GOGO 5\TEST RENAME\102420 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	font__622_VOLLEYBALL_MD_102420_UTSA_Volleyball_BAILEY_11.pdf	9.pdf
a:\GOGO 5\TEST RENAME\102419 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	FONT__622_VOLLEYBALL_XL_102419_UTSA_Volleyball_TURNER_8.pdf	10.pdf

 

[Joe4]

Hi Brian,

I just dig the code. I tried to use it but just work for 1 row. May you help to advise how to work all lines? Please see the screenshot. Thank you!

Path	Originalfilename	Newfilename
a:\GOGO 5\TEST RENAME\105244 - Arkansas State_Replica Jersey Volleyball	LG_622_VOLLEYBALL_105244_ArkansasState_ReplicaJerseyVolleyball.pdf	1.pdf
a:\GOGO 5\TEST RENAME\99950 - North Texas - NCAA Women's Volleyball Black Jersey\Print FIles\	YXL_622_99950_NILAT_2023.pdf	2.pdf
a:\GOGO 5\TEST RENAME\102419 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	FONT__622_VOLLEYBALL_MD_102419_UTSA_Volleyball_TURNER_8.pdf	3.pdf
a:\GOGO 5\TEST RENAME\102423 - Hawaii - NCAA Women's Volleyball Black Jersey\	FONT__622_VOLLEYBALL_MD_102423_Hawaii_Black_LANE_2.pdf	4.pdf
a:\GOGO 5\TEST RENAME\104987 - Florida - NCAA Women's Volleyball White Fashion Jersey\	FONT__622_VOLLEYBALL_MD_104987_Florida_WhiteFashion_CORNIER_2.pdf	5.pdf
a:\GOGO 5\TEST RENAME\104987 - Florida - NCAA Women's Volleyball White Fashion Jersey\	FONT__622_VOLLEYBALL_SM_104987_Florida_WhiteFashion_CORNIER_2.pdf	6.pdf
a:\GOGO 5\TEST RENAME\102423 - Hawaii - NCAA Women's Volleyball Black Jersey\	FONT__622_VOLLEYBALL_LG_102423_Hawaii_Black_LANE_2.pdf	7.pdf
a:\GOGO 5\TEST RENAME\101587 - Boston College - NCAA Women's Volleyball White Jersey\	FONT__622_VOLLEYBALL_MD_101587_BostonCollege_White_SCHRODER_2.pdf	8.pdf
a:\GOGO 5\TEST RENAME\102420 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	font__622_VOLLEYBALL_MD_102420_UTSA_Volleyball_BAILEY_11.pdf	9.pdf
a:\GOGO 5\TEST RENAME\102419 - UTSA - NCAA Women's Volleyball Volleyball Jersey\	FONT__622_VOLLEYBALL_XL_102419_UTSA_Volleyball_TURNER_8.pdf	10.pdf

Brian hasn't been on this board in over 5 years!

You are usually better off posting your question to a new thread (and include any links to old threads, if you like), then posting to an old thread with inactive users.
That way it will be seen in the "Unanswered threads" listing and get more people looking at it.