Question

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

示例：从“ Jan”到“ Feb”，从“ Bank”到“ Cash”，从“ Test”到“ Sharp”等。（银行对帐单Jan.xls-> JPM对帐单Jan.xls，表格测试。 xls->形成Sharp.xls等）

我使用一个函数来填充所有文件夹中的文件，并且子文件夹还拾取了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

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

1 个答案: