Help edit code rename file for all subfolder!!!

[Nguyen Anh Dung]

I have folder Image_Sonha include subforder as picture below.

And In subfolder : 20210406_18_001_HCG_DKT1_01, 20210406_18_002_HCG_DKT1_02, 20210406_18_003_HCG_DKT2_01, 20210406_18_004_HCG_DKT2_02 is have picture as below

i have code only repleace file G0019196_compressed->G0019196 and over write but only one folder. help edit code run for all subfolder in folder Image_SoNha

Sub Rename_overwrite()
Dim sPath As String, dPath As String, myOF As String
Dim lFor As String, ckLFor As Long
sPath = "C:\Users\dungna\Desktop\test\Image_SoNha\20210406_18_001_HCG_DKT1_01"     '<<< The start directory
dPath = "C:\Users\dungna\Desktop\test\Image_SoNha\20210406_18_001_HCG_DKT1_01"     '<<< The destination directory
lFor = "_compressed"              '<<< the Key to search
'
myOF = Dir(sPath & "*.JPG")
Do While myOF <> ""
    ckLFor = InStr(1, myOF, lFor, vbTextCompare)
    If ckLFor > 0 Then
        On Error Resume Next
        Kill dPath & Left(myOF, ckLFor - 1) & ".JPG"
        Name sPath & myOF As dPath & Left(myOF, ckLFor - 1) & ".JPG"
        On Error GoTo 0
    End If
    myOF = Dir
Loop
End Sub

Best regards,
Nguyen Anh Dung

 

[Joe4]

Take a look here: rename file names in a folder and files inside subfolders, vba