Thay thế đổi tên file trong excel bằng VBA

[Harry90]

Xin chỉ giáo VBA copy tên của file excel A và paste thay thế cho tên file excel B ( thực hiện thao tác trên file C vì file A và B đang đóng)
Rất mong anh chị chỉ giáo giúp em ạ
em cảm ơn ạ

 

[snow25]

Xin chỉ giáo VBA copy tên của file excel A và paste thay thế cho tên file excel B ( thực hiện thao tác trên file C vì file A và B đang đóng)
Rất mong anh chị chỉ giáo giúp em ạ
em cảm ơn ạ

Nghiên cứu FileSystemObject đổi tên file.

 

[VetMini]

Nghiên cứu FileSystemObject đổi tên file.

Anh làm giùm em đi. Việc có chút xíu mà phải nghiên cứu thì nó không hiệu quả.

 

[hvnhpro]

code lượm nhặt bạn nghiên cứu thêm về FileSystemObject nhé

1. chạy Code lấy danh file trong folder.
Bạn để đường dẫn folder này ở ô B1

Sub GETFILENAME()
Dim a, fo, fi As String
Dim i As Integer
Dim fso As Object

Set fso = VBA.CreateObject("Scripting.FileSystemObject")
a = ActiveWorkbook.Name
If Not fso.FolderExists(Workbooks(a).Sheets(1).Range("B1").Value) Then
MsgBox "Folder Error"
Else
fo = Workbooks(a).Sheets(1).Range("B1").Value
fi = Dir(fo & "\" & "*.*")
i = 1
Workbooks(a).Sheets(1).Range("C2:D1048576").ClearContents
Do While fi <> ""
i = i + 1
Workbooks(a).Sheets(1).Cells(i, 3).Value = fi
fi = Dir
Loop
End If
MsgBox "LAY DANH SACH FILE XONG!"
End Sub

2. Sau khi chạy code sẽ liệt kê tên file ở cột C.
bạn điền tên file cần sửa tương ứng dòng ở C tại cột D.

3. chạy code sửa tên file
bạn có thể xóa những dòng mà tên file ko cần sửa tên.

Sub DoiTenFileName()

Dim fso As Object
Dim OldName As String, NewName As String
Dim a, fo, fi, fin As String
Dim i As Integer
Dim ws As Worksheet


Set fso = CreateObject("Scripting.FileSystemObject")
a = ActiveWorkbook.Name
If Not fso.FolderExists(Workbooks(a).Sheets(1).Range("B1").Value) Then
MsgBox "Folder Error"
Else
fo = Workbooks(a).Sheets(1).Range("B1").Value

i = 1
Do
i = i + 1
fi = Workbooks(a).Sheets(1).Cells(i, 3).Value
fin = Workbooks(a).Sheets(1).Cells(i, 4).Value

If fi = "" Then Exit Do Else

If fin = "" Then
Else


OldName = fo & "\" & fi
NewName = fo & "\" & fin

    If fso.FileExists(OldName) Then fso.MoveFile OldName, NewName

End If

Loop
End If
Set fso = Nothing

MsgBox "DOI TEN FILE XONG!"
End Sub