嘿，我帮你找出了导致错误53的核心问题，还有几个辅助的逻辑漏洞，咱们一步步解决：

核心问题：错误地替换了整个文件路径而非仅文件名 #

你的代码里用Replace(vFile, FindTerm, ReplaceTerm)处理完整的文件路径（比如C:\Bank Files\Bank Statement Jan.xls），如果要替换的字符串（比如"Bank"）刚好出现在文件夹名称里，生成的新路径会指向一个不存在的文件夹（比如C:\Cash Files\Cash Statement Jan.xls），系统找不到这个目标文件夹，自然抛出“文件未找到”的错误。

而你的需求是仅替换文件名中的指定字符串，所以应该把文件路径拆分为「文件夹路径」和「文件名」两部分，只对文件名做替换操作。

其他辅助问题 #

1. getFileList的文件筛选逻辑错误：当前用oFile.Path Like FileFilter判断，但FileFilter是针对文件名的通配符（比如*.xls），路径里包含\，这个判断会失效，应该改用oFile.Name Like FileFilter。
2. 遍历顺序问题：原函数先遍历子文件夹再遍历文件，如果重命名了某个子文件夹，后续遍历该子文件夹内的文件时用的还是旧路径，会导致文件找不到。调整为先遍历当前文件夹的文件，再遍历子文件夹即可避免。

修正后的完整代码 #

Sub BatchRenameFiles()
    Dim filedlg As FileDialog
    Dim xPath As String
    Dim fileList As Object
    Dim vFile As Variant
    Dim FindTerm As String, ReplaceTerm As String
    Dim folderPath As String, fileName As String, newFileName As String, newFullPath As String
    
    ' 选择目标文件夹
    Set filedlg = Application.FileDialog(msoFileDialogFolderPicker)
    With filedlg
        .Title = "Please select folder"
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then Exit Sub ' 取消选择则退出
        xPath = .SelectedItems(1) & "\"
    End With
    
    ' 获取替换关键词
    FindTerm = InputBox("Find string:")
    If FindTerm = "" Then Exit Sub ' 空输入则退出
    ReplaceTerm = InputBox("Replace with:")
    
    ' 获取所有文件的完整路径
    Set fileList = getFileList(xPath)
    
    ' 遍历并重命名文件
    For Each vFile In fileList
        ' 拆分路径为文件夹路径和文件名
        folderPath = Left(vFile, InStrRev(vFile, "\"))
        fileName = Mid(vFile, InStrRev(vFile, "\") + 1)
        
        ' 仅当文件名包含目标字符串时才替换
        If fileName Like "*" & FindTerm & "*" Then
            newFileName = Replace(fileName, FindTerm, ReplaceTerm)
            newFullPath = folderPath & newFileName
            
            ' 执行重命名，增加错误捕获
            On Error Resume Next
            Name vFile As newFullPath
            If Err.Number <> 0 Then
                MsgBox "Failed to rename file:" & vbCrLf & vFile & vbCrLf & "Error: " & Err.Description, vbExclamation
            End If
            On Error GoTo 0
        End If
    Next vFile
    
    MsgBox "Rename process completed!", vbInformation
End Sub

Function getFileList(Path As String, Optional FileFilter As String = "*.*", Optional fso As Object, Optional list As Object) As Object
    Dim BaseFolder As Object, oFile As Object
    Dim subFolder As Object
    
    If fso Is Nothing Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set list = CreateObject("System.Collections.ArrayList")
    End If
    
    ' 确保路径末尾有反斜杠
    If Not Right(Path, 1) = "\" Then Path = Path & "\"
    
    ' 检查路径是否存在
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MsgBox "Folder does not exist: " & Path, vbCritical
        Set getFileList = list
        Exit Function
    End If
    
    Set BaseFolder = fso.GetFolder(Path)
    
    ' 先遍历当前文件夹的文件（避免文件夹重命名影响后续文件路径）
    For Each oFile In BaseFolder.Files
        ' 基于文件名筛选，而非完整路径
        If oFile.Name Like FileFilter Then
            list.Add oFile.Path
        End If
    Next
    
    ' 再遍历子文件夹（递归）
    For Each subFolder In BaseFolder.SubFolders
        Set list = getFileList(subFolder.Path, FileFilter, fso, list)
    Next
    
    Set getFileList = list
End Function

关键改进点说明 #

1. 拆分路径与文件名：用InStrRev找到最后一个反斜杠的位置，拆分出文件夹路径和文件名，只对文件名执行替换，确保不会修改文件夹路径。
2. 修正文件筛选逻辑：把oFile.Path Like FileFilter改为oFile.Name Like FileFilter，符合通配符筛选文件名的需求。
3. 调整遍历顺序：先处理当前文件夹的文件，再递归子文件夹，避免文件夹重命名后导致后续文件路径失效。
4. 增加错误捕获：重命名时加入错误处理，遇到无法重命名的文件（比如文件被占用）会弹出提示，而不是直接终止程序。

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