使用VBA名称功能重命名文件无法正常工作

Question

我正在准备一个代码，该代码每月都会帮助用户重命名多个文件中的特定字符串。

示例：从" jan"到" feb"，从"银行"到"现金"，从"测试"到"夏普"等(银行声明Jan.xls-> jpm语句Jan.xls，表单测试。xls->形成sharp.xl等(

我使用一个函数来填充所有文件夹的文件，并且子文件夹也选择了FileDialog，然后提示用户到InputBox字符串，并在文件名中替换字符串。

Sub testrenametest()
    Dim filedlg As FileDialog 
    Dim xPath As String 
    Dim fileList As Object 
    Dim vFile As Variant 
    Dim FindTerm As String, ReplaceTerm As String, NewFileName As String
    Set filedlg = Application.FileDialog(msoFileDialogFolderPicker)
    With filedlg
        .Title = "Please select folder"
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then End
        xPath = .SelectedItems(1) & ""
    End With
    FindTerm = InputBox("Find string:") ReplaceTerm = InputBox("Replace with:")
    Set fileList = getFileList(xPath)
    For Each vFile In fileList
        If vFile Like "*" & FindTerm & "*" Then
                NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
                Name vFile As NewFileName
        End If
    Next vFile 
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
    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 "You need to browse folder first!"
        End
    End If
    Set BaseFolder = fso.GetFolder(Path)
    For Each oFile In BaseFolder.SubFolders
        getFileList oFile.Path, FileFilter, fso, list
    Next
    For Each oFile In BaseFolder.Files
        If oFile.Path Like FileFilter Then list.Add oFile.Path
    Next
    Set getFileList = list
End Function

---

它适用于某些字符串，例如月份的名称，但例如"测试"或"银行"。它在行名为vfile上的 Run-time error 53 File not found表示为newfileName，但文件存在。很抱歉输入整个代码，但我无法确定可能是一个问题的地方。

Answer 1

您的问题可能在于它正在尝试重命名循环中不再存在该名称的文件。通过第一次仔细检查以确保文件仍然存在。

For Each vFile In fileList
    If vFile Like "*" & FindTerm & "*" Then
            NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
            If Dir$(vFile) <> "" Then
                    Name vFile As NewFileName
             End If
    End If
Next vFile 

编辑：提供了其他反馈后，问题是在路径中也发现了替换的字符串，我建议以下修复程序：

For Each vFileSpec In fileList
   vPath = Left(vFile, InstrRev(vFileSpec, "") - 1)
   vFile = Mid(vFileSpec, Len(vPath) + 1)
    If vFile Like "*" & FindTerm & "*" Then
            NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
             Name vFileSpec As vPath + "" + NewFileName
    End If
Next vFile