excel - 如何重命名多个文件 Excel VBA

问题描述

我的系统中有这些文件

我正在尝试使用下面的代码将这些文件名重命名为新名称，但代码运行并选择文件夹并且没有任何反应。

任何帮助将不胜感激。

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

标签： excelvba

我用它来将目录读入 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

然后我通常会使用替代公式来更改 E 列中的文件名，然后运行以下宏（注意宏从光标处开始）您还可以添加任何想要的方法来更改此子项中的文件名：

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

（请注意，如果读取目录太慢，您可以删除将大小和上次修改时间放入 c 和 d 列的部分。）

excel - 如何重命名多个文件 Excel VBA

问题描述

解决方案

推荐阅读