Renaming files from Excel VBA

Hi Everyine,

I have below code for renaming files , It only rename the file which is given in the path. I wan to rename files in subfolders. Please Help me out.

Please [Sub rename_files()
Dim v_Uq_Part As Variant, v_New_Name As Variant, tmp As Variant
Dim o_FSO As Object, o_Fold As Object, o_File As Object
Dim i As Long
Dim s_Tmp As String, s_Ext As String


Const S_PATH As String = "F:\testing"


'set file scripting object
Set o_FSO = CreateObject("scripting.FileSystemObject")


'bring in data from sheet to 2D variant array
v_Uq_Part = Range([a1], [a1].Offset(Cells(Rows.Count, 1).End(xlUp).Row - 1))
v_New_Name = Range([b1], [b1].Offset(Cells(Rows.Count, 1).End(xlUp).Row - 1))


'if last row in the second column is less then the first error
If UBound(v_New_Name) < UBound(v_Uq_Part) Then
    MsgBox "Please enter new names for each existing part name"
    Exit Sub
End If


'check if path exists
If Not o_FSO.folderexists(S_PATH) Then
    MsgBox "Input path is incorrect"
    Exit Sub
End If


'set folder object
Set o_Fold = o_FSO.getfolder(S_PATH)


'iterate through each file
For Each o_File In o_Fold.Files
    s_Tmp = o_File.Name
    For i = 1 To UBound(v_Uq_Part)
        If InStr(1, s_Tmp, v_Uq_Part(i, 1)) > 0 Then
            If InStr(1, v_New_Name(i, 1), ".") = 0 Then s_Ext = "." & Split(s_Tmp, ".")(1) Else s_Ext = ""
            o_File.Name = v_New_Name(i, 1) & s_Ext
            Exit For
        End If
    Next i
Next o_File


End Sub]Login or Register [/url] to view this content.