如何用Excel VBA批量重命名文件？代码运行无效果如何解决

问题原因排查 #

• 错误被静默忽略：代码中加入的On Error Resume Next会跳过所有匹配失败、重命名报错的场景，没有任何错误提示，无法定位问题根源
• 工作表引用不明确：代码中的Range("A:A")、Cells(curRow, "B")默认读取当前激活的工作表内容，如果运行代码时选中的不是存放新旧文件名对照表的工作表，永远不会匹配到结果
• 未过滤文件夹：Dir("*")会同时返回目标路径下的子文件夹名称，尝试重命名文件夹会触发错误，被静默跳过
• 文件名匹配失败：如果A列填写的文件名缺少扩展名，或者和实际文件名的大小写、空格、特殊字符有细微差异，Match函数会匹配失败
• 新文件名不合法：如果B列的新名称包含/ \ : * ? " < > |等Windows文件名非法字符，或者目标路径下已有重名文件，重命名操作会直接失败

修复后代码 #

Sub RenameMultipleFiles()
    ' 此处改为你存放新旧文件名对照表的工作表名称，例如Sheet1
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            Dim selectDirectory As String
            selectDirectory = .SelectedItems(1) & Application.PathSeparator
            Dim dFileList As String
            dFileList = Dir(selectDirectory & "*")
        
            Do Until dFileList = ""
                ' 跳过子文件夹，仅处理文件
                If (GetAttr(selectDirectory & dFileList) And vbDirectory) <> vbDirectory Then
                    Dim curRow As Variant
                    curRow = Application.Match(dFileList, ws.Range("A:A"), 0)
                    ' 判断是否匹配到结果
                    If Not IsError(curRow) Then
                        Dim newName As String
                        newName = ws.Cells(curRow, "B").Value
                        If newName <> "" Then
                            ' 仅在重命名步骤捕获错误，抛出提示
                            On Error Resume Next
                            Name selectDirectory & dFileList As selectDirectory & newName
                            If Err.Number <> 0 Then
                                MsgBox "文件重命名失败：" & dFileList & vbCrLf & "错误原因：" & Err.Description
                                Err.Clear
                            End If
                            On Error GoTo 0
                        End If
                    End If
                End If
                dFileList = Dir
            Loop
            MsgBox "重命名操作执行完毕"
        End If
    End With
End Sub

使用注意事项 #

• 新旧文件名对照表要放在同一个工作表的A、B列：A列填写完整原文件名（包含扩展名），B列填写完整新文件名（包含扩展名）
• 运行代码前确认代码中指定的工作表名称和你实际存放对照表的工作表名称一致
• 重命名前先备份所有原文件，避免操作失误导致文件丢失或无法打开
• 如果收到重命名失败提示，对应检查新文件名是否合法、是否已有重名文件

内容的提问来源于stack exchange，提问作者user16978245