I am attempting to rename files found in a main folder, but then put the renamed files in the same directory as the files to be copied. This is my original folder structure:

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

I want to now create a folder under the Main Folder called "Renamed" and place the renamed files in there. The new folder structure should look like this after successfully executing the code:

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

However, in the code that I have so far, I cannot create the "Renamed" folder under the Main Folder as I get the error message Run-time error '5': Invalid procedure call or argument that seem to occur at the line fso.CopyFolder sItem, strPath2. Can you help me create the folder structure with the renamed folder and files.

Here is my code:

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

CodePudding user response：

Copy and Rename Files Using Dir and FileCopy

• Using FileCopy is much faster, simpler, and more straightforward: it copies and renames in one go.
• This is a simplified example to get you familiar with Dir and FileCopy. In your case, you would 'Dir' each name in column A and if the length of the filename is greater than 0 (confirming that the file exists), you would '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