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

Question

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

Answer 1

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