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! =)

 

[BrianMH]

This should work.

Sub rFiles()    Dim fs As FileSystemObject
    Dim fdBase As Folder
    Dim f As File
    Dim sFV As String
    Dim sTV As String
    Dim sPath As String
    Dim sName As String
    Dim sFullName As String
    sPath = Range("A2")
    sFV = Range("B2")
    sTV = Range("C2")
    Set fs = New FileSystemObject
    If Not fs.FolderExists(sPath) Then
        MsgBox "Invalid Path"
        Exit Sub
    End If
    Set fdBase = fs.GetFolder(sPath)
    For Each f In fdBase.Files
        sName = f.Name
        sName = Replace(sName, sFV, sTV)
        sFullName = f.ParentFolder & "\" & sName
        Name f As sFullName
    Next
    
    For Each fd In fdBase.SubFolders
        For Each f In fd.Files
            sName = f.Name
            sName = Replace(sName, sFV, sTV)
            sFullName = f.ParentFolder & "\" & sName
            Name f As sFullName
        Next
    Next
    
    
    
End Sub

 

[ARobb4]

Hi Brian, thanks for the response

although it still gives the same error msg..
and highlights the line

Name f As sFullName

i'm only trying to rename the files who has "14" on their file names...
and the ones who do not, will be left alone

ex
Rename.xlsm = Rename.xlsm
ouch14_pain.txt = ouch15_pain.txt
.
.
.

i believe that what your code does, is that it goes through all the files in the base folder. is it possible to skip those file names who does not have "14" on them?

 

[BrianMH]

Here you are. If it errors due to file access that probably means the file is open somewhere.

Sub rFiles()   
    Dim fs As FileSystemObject
    Dim fdBase As Folder
    Dim f As File
    Dim sFV As String
    Dim sTV As String
    Dim sPath As String
    Dim sName As String
    Dim sFullName As String
    sPath = Range("A2")
    sFV = Range("B2")
    sTV = Range("C2")
    Set fs = New FileSystemObject
    If Not fs.FolderExists(sPath) Then
        MsgBox "Invalid Path"
        Exit Sub
    End If
    Set fdBase = fs.GetFolder(sPath)
    For Each f In fdBase.Files
        sName = f.Name
        sName = Replace(sName, sFV, sTV)
        sFullName = f.ParentFolder & "\" & sName
        Name f As sFullName
    Next
    
    For Each fd In fdBase.SubFolders
        For Each f In fd.Files
            if f.name like "*" & sFV & "*" then
                sName = f.Name
                sName = Replace(sName, sFV, sTV)
                sFullName = f.ParentFolder & "\" & sName
                Name f As sFullName
            end if
        Next
    Next
    
    
    
End Sub

 

[ARobb4]

ohh... that's why.. thank you so much sir, its working now...

****, i'm really far from being a great programmers like you guys... :'(

 

[ARobb4]

sir brian, one more thing.. i need the files to be renamed in "all" subfolders meaning.. subfolders within a subfolder and within and so on.....

what the latest code does is it just renames all the files in the base path and the first layer of subfolders... i need it to rename even within the deepest layer

i'm so sorry for being so demanding... but your code is as powerful as it is, its just that, i lack brain power in modifying it

 

[BrianMH]

Here you are. Keep at it. I learned from forums and help files. I participate on here to learn more. Today I found out about recursive programming (calling a sub from itself), I never knew you could do this.

Recursion And The FileSystemObject

Dim fs As FileSystemObject

Sub caller()
Dim fd As Scripting.Folder
Dim sPath As String
If fs Is Nothing Then
    Set fs = New FileSystemObject
End If
sPath = Range("A2")




If Not fs.FolderExists(sPath) Then
    MsgBox "Folder Doesn't Exist"
    Exit Sub
End If


Set fd = fs.GetFolder(sPath)
rFiles fd, Range("B2").Value, Range("C2")
End Sub


Sub rFiles(fd As Scripting.Folder, sFV As String, sTV As String)
    


    Dim f As File
    Dim sName As String
    Dim sFullName As String
    
    If fs Is Nothing Then
        Set fs = New FileSystemObject
    End If
    
    For Each f In fd.Files
        If f.Name Like "*" & sFV & "*" Then
                sName = f.Name
                sName = Replace(sName, sFV, sTV)
                sFullName = f.ParentFolder & "\" & sName
                Name f As sFullName
        End If
    Next
    
    For Each fd In fd.SubFolders
        rFiles fd, sFV, sTV
    Next
    
    
    
End Sub

 

[ARobb4]

wow!! @_@
i'm speechless! you're really good at this sir, it works perfectly!! THANK YOU SO MUCH!!
will do sir! =))

 

[Skvba]

I am trying to modify the code from this thread to change the string "This" to "That" in every filename where "This" occurs anywhere in that filename. I have tried to enter the path of the base folder and the"This" to "That" strings directly, rather than pull them from a cell as it appears the original code does.

I receive the error message "Compile error: User-defined type not defined" when running the code as written below:

Sub caller()
Dim fd As Scripting.Folder
Dim sPath As String
If fs Is Nothing Then
Set fs = New FileSystemObject
End If
' sPath = Range("A2")
sPath = ExcelPath & "\" & Division & "\"

If Not fs.FolderExists(sPath) Then
MsgBox "Folder Doesn't Exist"
Exit Sub
End If

Set fd = fs.GetFolder(sPath)
' rFiles fd, Range("B2").Value, Range("C2")
rFiles fd, "This", "That"
End Sub
Sub rFiles(fd As Scripting.Folder, sFV As String, sTV As String)
Dim f As File
Dim sName As String
Dim sFullName As String
If fs Is Nothing Then
Set fs = New FileSystemObject
End If

For Each f In fd.Files
If f.Name Like "*" & sFV & "*" Then
sName = f.Name
sName = Replace(sName, sFV, sTV)
sFullName = f.ParentFolder & "\" & sName
Name f As sFullName
End If
Next
For Each fd In fd.SubFolders
rFiles fd, sFV, sTV
Next
End Sub

Any help with this would be very much appreciated. Thank you, Sky

 

[BrianMH]

You need to add a reference for scripting runtime.