Đổi tên nhiều thư mục một cách nhanh nhất.

le_anh81 · 7/11/19

Chào cả nhà!

Em cần sửa tên nhiều thư mục và không thể ngồi sửa tên từng thư mục một.
Qua tìm hiểu em có biết đến bài này để sửa tên nhiều file một cách nhanh chóng

http://www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BB%95i-t%C3%AAn-file.90985/#post-568326

Ai có thể giúp em sửa code để có thể sửa được tên nhiều thư mục một cách nhanh nhất.
Em cảm ơn.

SA_DQ · 7/11/19

https://www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BB%95i-t%C3%AAn-nhi%E1%BB%81u-th%C6%B0-m%E1%BB%A5c-nhanh-nh%E1%BA%A5t.146124/

le_anh81 · 8/11/19

Là sao ah?

SA_DQ đã viết:
https://www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BB%95i-t%C3%AAn-nhi%E1%BB%81u-th%C6%B0-m%E1%BB%A5c-nhanh-nh%E1%BA%A5t.146124/

vanle33 · 8/11/19

@le_anh81 : Là bạn đăng nhiều bài với nội dung tương tự đó.

leonguyenz · 8/11/19

le_anh81 đã viết:
Chào cả nhà!

Em cần sửa tên nhiều thư mục và không thể ngồi sửa tên từng thư mục một.
Qua tìm hiểu em có biết đến bài này để sửa tên nhiều file một cách nhanh chóng

http://www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BB%95i-t%C3%AAn-file.90985/#post-568326

Ai có thể giúp em sửa code để có thể sửa được tên nhiều thư mục một cách nhanh nhất.
Em cảm ơn.

Sửa lại code Rename_Folder

Mã:

Sub Rename_Folder()
Const LFolder As String = "C:\Users\MyPC\Desktop\"
Dim fileNum As Long, oldName As String, newName As String, i As Long
On Error Resume Next
With Sheet1
    fileNum = Range("B2").End(xlDown).Row
    If fileNum > 1 Then
        For i = 2 To fileNum
            oldName = LFolder & Cells(i, 2).Value
            newName = LFolder & Cells(i, 4).Value
            Name oldName As newName
        Next i
    End If
End With
End Sub

snow25 · 8/11/19

le_anh81 đã viết:
Chào cả nhà!

Em cần sửa tên nhiều thư mục và không thể ngồi sửa tên từng thư mục một.
Qua tìm hiểu em có biết đến bài này để sửa tên nhiều file một cách nhanh chóng

http://www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BB%95i-t%C3%AAn-file.90985/#post-568326

Ai có thể giúp em sửa code để có thể sửa được tên nhiều thư mục một cách nhanh nhất.
Em cảm ơn.

Bạn thử.

Mã:

Sub doiten()
    Dim fso As Object, arr, lr As Long, i As Long, tenfile As String, filemoi As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Sheets("rename")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr = 1 Then Exit Sub
         arr = .Range("B2:D" & lr).Value
         For i = 1 To UBound(arr)
             tenfile = arr(i, 1) & "\" & arr(i, 2)
             filemoi = arr(i, 1) & "\" & arr(i, 3)
             If fso.FileExists(tenfile) Then
                fso.CopyFile tenfile, filemoi
                fso.DeleteFile (tenfile)
             End If
         Next i
   End With
End Sub

le_anh81 · 8/11/19

Cảm ơn bác, mình đã updated code cho phần Rename, nhưng bấm "get file" nó vẫn list toàn bộ file ra để sửa tên, chứ ko phải hiển thị tên thư mục.
Vậy, làm thế nào để sửa tên thư mục. Nếu được bác giúp em update và cho em xin cái file.
Em cảm ơn.

leonguyenz đã viết:

Sửa lại code Rename_Folder

Mã:

Sub Rename_Folder()
Const LFolder As String = "C:\Users\MyPC\Desktop\"
Dim fileNum As Long, oldName As String, newName As String, i As Long
On Error Resume Next
With Sheet1
    fileNum = Range("B2").End(xlDown).Row
    If fileNum > 1 Then
        For i = 2 To fileNum
            oldName = LFolder & Cells(i, 2).Value
            newName = LFolder & Cells(i, 4).Value
            Name oldName As newName
        Next i
    End If
End With
End Sub

Bài đã được tự động gộp: 8/11/19

le_anh81 · 11/11/19

Ai giúp em với ah. E vẫn chưa thể đổi tên nhiều thư mục đơn giản hơn.

quanluu · 11/11/19

Như thế nào là nhanh nhất vậy bạn? mấy code trên có vấn đề gì vậy?

HieuCD · 11/11/19

le_anh81 đã viết:
Ai giúp em với ah. E vẫn chưa thể đổi tên nhiều thư mục đơn giản hơn.

Bạn nên làm lại file với bảng gồm 2 cột: tên thư mục cần sửa và tên thư mục mới

le_anh81 · 12/11/19

Cảm ơn bác @HieuCD, em xin gửi lại file thể hiện mong muốn của em.
Mong bác và mọi người giúp em.
Em cảm ơn.

leonguyenz · 12/11/19

le_anh81 đã viết:
Cảm ơn bác @HieuCD, em xin gửi lại file thể hiện mong muốn của em.
Mong bác và mọi người giúp em.
Em cảm ơn.

View attachment 228157

Hàm lấy đường dẫn, tên Folder:

Mã:

Option Explicit

Dim i As Long
Dim Arr(1 To 10000, 1 To 2)

Function GetFold(LinkFolder As String)
    Dim sFolder As Object
    Dim Fold As Object
    With CreateObject("Scripting.FileSystemObject")
        Set sFolder = .GetFolder(LinkFolder).SubFolders
        If sFolder.Count > 0 Then
            For Each Fold In .GetFolder(LinkFolder).SubFolders
                If Left(Fold.Name, 1) <> "~" Then
                    i = i + 1
                    Arr(i, 1) = LinkFolder
                    Arr(i, 2) = Fold.Name
                End If
            Next
        End If
    End With
End Function

Code lấy đường dẫn, tên Folder và gán xuống bảng tính:

Mã:

Sub GetFolderName()
    Dim Source As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        Source = .SelectedItems(1)
    End With
    i = 0
    GetFold (Source)
    With Sheet1
        Range("A2:C65536").ClearContents
        Range("A2").Resize(i, 2) = Arr
    End With
End Sub

Code đổi tên Folder:

Mã:

Sub Rename_Folder()
Dim FoldNum As Long, LFolder As String, oldName As String, newName As String
On Error Resume Next
With Sheet1
    FoldNum = Range("B65535").End(xlUp).Row
    If FoldNum > 1 Then
        For i = 2 To FoldNum
            LFolder = Cells(i, 1).Value & "\"
            oldName = LFolder & Cells(i, 2).Value
            newName = LFolder & Cells(i, 3).Value
            Name oldName As newName
        Next i
    End If
End With
End Sub

le_anh81 · 12/11/19

Bác chi tiết quá, rất cảm ơn bác.

leonguyenz đã viết:

Hàm lấy đường dẫn, tên Folder:

Mã:

Option Explicit

Dim i As Long
Dim Arr(1 To 10000, 1 To 2)

Function GetFold(LinkFolder As String)
    Dim sFolder As Object
    Dim Fold As Object
    With CreateObject("Scripting.FileSystemObject")
        Set sFolder = .GetFolder(LinkFolder).SubFolders
        If sFolder.Count > 0 Then
            For Each Fold In .GetFolder(LinkFolder).SubFolders
                If Left(Fold.Name, 1) <> "~" Then
                    i = i + 1
                    Arr(i, 1) = LinkFolder
                    Arr(i, 2) = Fold.Name
                End If
            Next
        End If
    End With
End Function

Code lấy đường dẫn, tên Folder và gán xuống bảng tính:

Mã:

Sub GetFolderName()
    Dim Source As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        Source = .SelectedItems(1)
    End With
    i = 0
    GetFold (Source)
    With Sheet1
        Range("A2:C65536").ClearContents
        Range("A2").Resize(i, 2) = Arr
    End With
End Sub

Code đổi tên Folder:

Mã:

Sub Rename_Folder()
Dim FoldNum As Long, LFolder As String, oldName As String, newName As String
On Error Resume Next
With Sheet1
    FoldNum = Range("B65535").End(xlUp).Row
    If FoldNum > 1 Then
        For i = 2 To FoldNum
            LFolder = Cells(i, 1).Value & "\"
            oldName = LFolder & Cells(i, 2).Value
            newName = LFolder & Cells(i, 3).Value
            Name oldName As newName
        Next i
    End If
End With
End Sub

quanluu · 12/11/19

Hàm Name sẽ bị lỗi nếu tên file là tiếng việt nhé.

saobekhonglac · 14/11/19

leonguyenz đã viết:

Hàm lấy đường dẫn, tên Folder:

Mã:

Option Explicit

Dim i As Long
Dim Arr(1 To 10000, 1 To 2)

Function GetFold(LinkFolder As String)
    Dim sFolder As Object
    Dim Fold As Object
    With CreateObject("Scripting.FileSystemObject")
        Set sFolder = .GetFolder(LinkFolder).SubFolders
        If sFolder.Count > 0 Then
            For Each Fold In .GetFolder(LinkFolder).SubFolders
                If Left(Fold.Name, 1) <> "~" Then
                    i = i + 1
                    Arr(i, 1) = LinkFolder
                    Arr(i, 2) = Fold.Name
                End If
            Next
        End If
    End With
End Function

Code lấy đường dẫn, tên Folder và gán xuống bảng tính:

Mã:

Sub GetFolderName()
    Dim Source As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        Source = .SelectedItems(1)
    End With
    i = 0
    GetFold (Source)
    With Sheet1
        Range("A2:C65536").ClearContents
        Range("A2").Resize(i, 2) = Arr
    End With
End Sub

Code đổi tên Folder:

Mã:

Sub Rename_Folder()
Dim FoldNum As Long, LFolder As String, oldName As String, newName As String
On Error Resume Next
With Sheet1
    FoldNum = Range("B65535").End(xlUp).Row
    If FoldNum > 1 Then
        For i = 2 To FoldNum
            LFolder = Cells(i, 1).Value & "\"
            oldName = LFolder & Cells(i, 2).Value
            newName = LFolder & Cells(i, 3).Value
            Name oldName As newName
        Next i
    End If
End With
End Sub

Anh làm giúp cái đổi tên file luôn đi Anh.

leonguyenz · 14/11/19

saobekhonglac đã viết:
Anh làm giúp cái đổi tên file luôn đi Anh.

Có sẵn hàm trong file ở bài #1 rồi đó

Đổi tên nhiều thư mục một cách nhanh nhất.

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên chính thức

Thành viên gắn bó

Thành viên mới

Thành viên gạo cội

Facebook

Group