I have these files in my system

and i am trying to rename these files name to new names using below code but codes runs and select the folder and nothing happens.

any help will be appreciated.

Sub RenameMultipleFiles()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectDirectory = .SelectedItems(1)
            dFileList = Dir(selectDirectory & Application.PathSeparator & "*")
        
            Do Until dFileList = ""
                curRow = 0
                On Error Resume Next
                curRow = Application.Match(dFileList, Range("A:A"), 0)
                If curRow > 0 Then
                    Name selectDirectory & Application.PathSeparator & dFileList As _
                    selectDirectory & Application.PathSeparator & Cells(curRow, "B").Value
                End If
        
                dFileList = Dir
            Loop
        End If
    End With
End Sub

CodePudding user response：

I use this for reading the directory into columns A - D:

Sub readDir(j As Folder)
    Dim k As file
    Dim i As Folder
    Dim o As Integer 'offset
    For Each k In j.Files
        ActiveCell.value = k
        ActiveCell.offset(0, 1).FormulaR1C1 = "=HYPERLINK(RC[-1],TRIM(RIGHT(SUBSTITUTE(RC[-1],""\"",REPT("" "",LEN(RC[-1]))),LEN(RC[-1]))))"
        ActiveCell.offset(0, 2).value = k.DateLastModified
        ActiveCell.offset(0, 3).value = k.Size
        Selection.offset(o, 0).Select
    Next
    For Each i In j.SubFolders
        readDir i
    Next
End Sub


Sub readDirectory()
    Dim i As FileSystemObject
    Dim j As Folder
    Dim fd As FileDialog
    Dim autoSv As Boolean
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If Val(Application.Version) > 15 Then
        autoSv = ActiveWorkbook.AutoSaveOn
        If autoSv Then ActiveWorkbook.AutoSaveOn = False: ActiveWorkbook.Save
    End If
    If fd.Show = 0 Then Exit Sub
    Set i = New FileSystemObject
    Set j = i.GetFolder(fd.SelectedItems(1)   "\")
    readDir j
    If Val(Application.Version) > 15 Then
        ActiveWorkbook.AutoSaveOn = autoSv
    End If
End Sub

Then I will typically use a substitute formula to alter the filename in column E, then run the following macro (note that macro starts at the cursor) you can also add any wanted method to alter the filename inside this sub:

Sub renamer()
    Dim currentrow As Integer
    currentrow = Selection.row
    While Len(Cells(currentrow, 1)) > 0 
        If (Len(Cells(currentrow, 1).value)) > 2 Then
             Name Cells(currentrow, 1).value As Cells(currentrow, 5).value
        End If
        currentrow = currentrow   1
    Wend
End Sub

(Note that if reading the directory is too slow, you can remove the part where it puts size and last modified time into columns c and d.)