Nhờ anh chị chỉnh sửa code chạy cho trường hợp tất cả folder!!!

[nguyenanhdung8111982]

em co 1 folder tổng như hình dưới




và trong mỗi thư mục con thì có file hình gồm file gốc G0019196 và file đã nén G0019196_compressed. Em có đoạn code như dưới dùng để rename lại tên cho đúng với tên file gốc và đè lên file gốc nhưng chỉ làm được cho 1 thư mục. Nhờ anh chị sửa code chạy cho hàng loạt thư mục con thay vì em chạy từng thư mục.

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

Cám ơn anh chị ,
Nguyen Anh Dung

 

[Maika8008]

Có chừng bao nhiêu thư mục con tất cả? Nếu nhiều làm chơi chứ ít thì bạn làm bằng tay vậy.

Thêm: chắc bạn làm nghề chụp ảnh?

 

[nguyenanhdung8111982]

Có chừng bao nhiêu thư mục con tất cả? Nếu nhiều làm chơi chứ ít thì bạn làm bằng tay vậy.

Thêm: chắc bạn làm nghề chụp ảnh?vi

Nhiều lắm bạn ơi, tầm 500 thư mục!!!

 

[VetMini]

Má ơi. Quản lý cái đống thư mục không đã đủ hết công việc.

 

[Maika8008]

Nhiều lắm bạn ơi, tầm 500 thư mục!!!

Bạn tải file về, nhập đoạn đuôi cần xóa (VD: _compressed) vào B1, đường dẫn thư mục mẹ chứa mấy file cần đổi tên vào B2 => Bấm nút Đổi tên.

 

[nguyenanhdung8111982]

Bạn tải file về, nhập đoạn đuôi cần xóa (VD: _compressed) vào B1, đường dẫn thư mục mẹ chứa mấy file cần đổi tên vào B2 => Bấm nút Đổi tên.

Cám ơn bạn, mình làm được rồi!!!

 

[nguyenanhdung8111982]

code mình đã sửa lại:

Sub RenameFilesInAllSubFolders()
Dim lFor As String, ckLFor As Long
Dim fso As Object, fold As Object, fFile As Object
Dim fPath As String, fName As String ', oldName As String, newName As String
'lFor = "_compressed"
lFor =InputBox("Enter character need delete: ")  'example: _compressed
fPath = InputBox("Enter path folder Image:")
'dPath = "C:\Users\dungna\Desktop\test\Image_SoNha"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fold = fso.GetFolder(fPath)
For Each fFile In fold.SubFolders
fName = Dir(fFile.path & "\*.JPG", vbNormal)
Do While fName <> ""
    ckLFor = InStr(1, fName, lFor, vbTextCompare)
    If ckLFor > 0 Then
        On Error Resume Next
     
        Kill fFile.path & "\" & Left(fName, ckLFor - 1) & ".JPG"
             
        Name fFile.path & "\" & fName As fFile.path & "\" & Left(fName, ckLFor - 1) & ".JPG"
        On Error GoTo 0
    End If
    fName = Dir
Loop
Next
MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
End Sub