重命名文件并将重命名的文件复制到主文件夹中的子文件夹

Question

我正在尝试重命名在主文件夹中找到的文件，然后将重命名的文件与要复制的文件放在同一目录中。这是我原来的文件夹结构：

Main Folder
    |
    |____file1.txt
    |____file2.txt
    |____file1.txt

我现在想在主文件夹下创建一个名为“重命名”的文件夹，并将重命名的文件放在那里。成功执行代码后，新文件夹结构应如下所示：

Main Folder
    |
    |____Renamed
    |      |
    |      |____renamed-file1.txt
    |      |____renamed-file2.txt
    |      |____renamed-file3.txt
    |
    |____file1.txt
    |____file2.txt
    |____file1.txt

但是，在我目前的代码中，我无法在主文件夹下创建“重命名”文件夹，因为我收到似乎出现在行 fso.CopyFolder sItem, strPath2 的错误消息 Run-time error '5': Invalid procedure call or argument ].你能帮我用重命名的文件夹和文件创建文件夹结构吗？

这是我的代码：

Sub RenameFile()
    Dim fldr As FileDialog
    Dim sItem As String
    Dim strPath As String
    Dim strPath1 As String
    Dim strPath2 As String
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    Dim z As String
    Dim s As String
    Dim V As Integer
    Dim TotalRow As Integer
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
      
    TotalRow = ActiveSheet.UsedRange.Rows.Count
    
NextCode:
    strPath = sItem
    strPath2 = fso.BuildPath(sItem, "Renamed")
    ' Create the folder "Renamed"
    fso.CopyFolder sItem, strPath2
    
    For V = 1 To TotalRow
        
        ' Get value of each row in columns 1 start at row 2
        z = Cells(V + 1, 1).Value
        ' Get value of each row in columns 2 start at row 2
        s = Cells(V + 1, 2).Value
        
        Dim sOldPathName As String
        sOldPathName = fso.BuildPath(strPath2, z)
        sNewPathName = fso.BuildPath(strPath2, s)
        Name sOldPathName As sNewPathName
        On Error Resume Next
        Name sOldPathName As s
        
    Next V
    
    MsgBox "Congratulations! You have successfully renamed all the files"
    
End Sub

Answer 1

使用 `Dir` 和 `FileCopy`

复制和重命名文件

使用 FileCopy 更快、更简单、更直接：它可以一次性复制和重命名。
这是一个让您熟悉 Dir 和 FileCopy 的简化示例。在您的情况下，您将 'Dir' 列中的每个名称 A 并且如果文件名的长度大于 0（确认文件存在），您将 'FileCopy the source path to the destination path (using the names in column B)'.

Sub RenameFiles()
    
    ' Source
    Const sFilePattern As String = "*.*"
    Dim sInitPath As String: sInitPath = Application.DefaultFilePath & "\"
    ' Destination
    Const dSubFolderName As String = "Renamed"
    Const dPrefix As String = "renamed-"
    
    Dim sFolderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = sInitPath
        If .Show <> -1 Then
            MsgBox "You canceled.", vbExclamation
            Exit Sub
        End If
        sFolderPath = .SelectedItems(1) & "\"
    End With
      
    Dim dFolderPath As String: dFolderPath = sFolderPath & dSubFolderName & "\"
    If Len(Dir(dFolderPath, vbDirectory)) = 0 Then MkDir dFolderPath
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No files found.", vbExclamation
        Exit Sub
    End If
        
    On Error GoTo FileCopyError
        Do Until Len(sFileName) = 0
            FileCopy sFolderPath & sFileName, dFolderPath & dPrefix & sFileName
            sFileName = Dir
        Loop
    On Error GoTo 0
    
    MsgBox "Congratulations! You have successfully renamed all the files.", _
        vbInformation
    
    Exit Sub
    
FileCopyError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description _
        & vbLf & "Could not copy '" & sFileName & "'."
    Resume Next

End Sub

重命名文件并将重命名的文件复制到主文件夹中的子文件夹

Rename files and copy the renamed files to subbolder in main folder

excel

vba

使用 `Dir` 和 `FileCopy`

重命名文件并将重命名的文件复制到主文件夹中的子文件夹

Rename files and copy the renamed files to subbolder in main folder

excel

vba

使用 Dir 和 FileCopy

使用 `Dir` 和 `FileCopy`