Bài này đơn giản, chỉ vài dòng code là được nhưng tên file có dấu tiếng việt thì thua rồi. Thêm nữa định dạng đuôi file của bạn trật lất rồi. Bạn cho view hết extension lên thì rõ.
Sub doitenfile()
On Error GoTo thongbao
Dim Nguon(), I As Long, path As String
Nguon = Range([B2], [B65536].End(3)).Resize(, 2).Value
path = ThisWorkbook.path & "\"
For I = 1 To UBound(Nguon)
With CreateObject("Scripting.FileSystemObject")
.Movefile path & Nguon(I, 1), path & Nguon(I, 2)
End With
Next
Exit Sub
thongbao: MsgBox "Loi tai file " & I
End SubToàn bộ file của bạn là .png, nếu bạn view extension lên thì sẽ thấy thế này 946.jpg.png >>> Code không tìm được file 946.jpg để đổi tên
À ra vậy. Cảm ơn anh, tôi đã thử với file.xls thì thấy hoạt động tốt. Nhưng anh cho hỏi sao các file như jpeg cũng không đổi được nhỉ. Mà chụp bằng điện thoại thì toàn file jpeg vậy nên làm thế nào.
Ẹc, đúng là mần được tiếng việt có dấu, em quên mất. Nhưng nếu không có dấu chắc ăn hơn.
Bạn đã mở được file thì tại sao lại không Save as được nhỉ? Bạn tải file bên dưới nhé.
Ơ em không để ý anh Nghĩa Phúc ạ. Cái File này em viết lâu rồi dùng ở cơ quan nên cứ post lên thôi.
Không phải, em đã tải rồi. Là em muốn thử save xem có vấn đề gì không thôi. Cảm ơn các anh.
Bạn ứng dụng được công việc là vui rồi. Tại bài trước tôi chưa mở pass VBA (cũng do sơ suất vì file đã viết từ lâu), tôi đã sửa bài trước mở pass rồi (Pass chỉ là "bịp" người mới thui). Dưới đây là toàn bộ Code nếu bạn muốn tìm hiều
'Get all file name in folder using
'==================================
Option Explicit
Dim i As Long
Dim Arr(1 To 10000, 1 To 3)
Function Getfile(Linkfolder As String)
Dim sFolder As Object 'SubFolder
Dim sfi As Object 'Subfolder of SubFolder
Dim fi As Object 'File
With CreateObject("Scripting.filesystemobject")
Set sFolder = .GetFolder(Linkfolder).SubFolders
If sFolder.Count > 0 Then
'If have files on Linkfolder then Get File Name
If .GetFolder(Linkfolder).Files.Count > 0 Then
For Each fi In .GetFolder(Linkfolder).Files
If Left(fi.Name, 1) <> "~" Then
i = i + 1
Arr(i, 1) = i
Arr(i, 3) = fi.Name
Arr(i, 2) = Linkfolder
End If
Next
End If
'De quy
For Each sfi In sFolder
Getfile (sfi)
Next
Else
'Get FileName on the Sub Folder
For Each fi In .GetFolder(Linkfolder).Files
'Exclude Temporary file
If Left(fi.Name, 1) <> "~" Then
i = i + 1
Arr(i, 1) = i
Arr(i, 3) = fi.Name
Arr(i, 2) = Linkfolder
End If
Next
End If
End With
End Function
Sub GetFilename()
Dim source As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
source = .SelectedItems(1)
End With
i = 0
Getfile (source)
Sheet1.Range("A2:D65536").ClearContents
Sheet1.Range("A2").Resize(i, 3) = Arr
End Sub
Sub Rename()
On Error Resume Next
Dim source As String, RenameArr
Dim t As Long
RenameArr = Sheet1.Range("A2:D" & Sheet1.Range("B65536").End(3).Row)
With CreateObject("Scripting.filesystemobject")
For t = 1 To UBound(RenameArr)
.MoveFile RenameArr(t, 2) & "\" & RenameArr(t, 3), RenameArr(t, 2) & "\" & RenameArr(t, 4)
Next
End With
MsgBox "Finish", vbInformation
End SubTôi thấy tác giả viết file này như vậy là hợp lý. Vì tên file và phần mở rộng là do người sử dụng quyết định.
