Rename files in multiple folders and copy to new folder

cmunoziii

New Member
Joined
Sep 22, 2013
Messages
6
For the last year I have been downloading cash register X1 and Z1 files onto an SD card. Each night's files (X1 & Z1) are stored in a new folder with the naming convention "RP + [DATE]", (EX: RP120910, [YYMMDD]). I have 265 folders!!!<br><br>
I need to go through each folder, select the Z1 file (I don't care about the X1, X2 or Z2 files) and rename each with the following naming convention: "Z1 + folder_name + .xls". For Example: Folder RP120910 contains the Z1 file named "Z1_T1729.ECR". After renaming, the file should be "Z1RP120910.xls".<br><br>
As the VBA code loops through each subfolder, selecting and renaming the Z1 files, I would like the new files to be placed into a new folder named "Z1Files".<br><br>
Note: All subfolders are currently in a directory named "RegisterFiles". I am using Excel 2010.<br><br>
Can someone please save me from having to manually go through each file and rename it. I would greatly appreciate any help.
 
Last edited:

patel45

Well-known Member
Joined
Jul 15, 2012
Messages
1,953
maybe you can arrange this code for your goal
Code:
Sub RenAllFilesInclSubFold()
    Dim fso As Object, fold As Object, fFile As Object
    Dim fPath As String, fName As String, oldName As String, newName As String
    fPath = "C:\test" ' ----- initial folder
    s = "_New"
'   ren files in parent folder
    fName = Dir(fPath & "\" & "*.xl*", vbNormal)
    Do While fName <> ""
        oldName = Left(fName, InStrRev(fName, ".") - 1)
        newName = Replace(fName, oldName, oldName & s)
       Name fPath & "\" & fName As fPath & "\" & newName
'        MsgBox "Name " & fPath & "\" & fName & " As " & fPath & "\" & newName
        fName = Dir
    Loop
'   ren files in subfolders
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fold = fso.GetFolder(fPath)
    For Each fFile In fold.subfolders
        fName = Dir(fFile.Path & "\*.xl*", vbNormal)
        Do While fName <> ""
            oldName = Left(fName, InStrRev(fName, ".") - 1)
            newName = Replace(fName, oldName, oldName & s)
            Name fFile.Path & "\" & fName As fFile.Path & "\" & newName
'            MsgBox "Name " & fPath & "\" & fName & " As " & fFilePath & "\" & newName
            fName = Dir
        Loop
    Next
'   ren subfolders
    fName = Dir(fPath & "\", vbDirectory)
    Do While fName <> ""
       If Left(fName, 1) <> "." Then
         newName = fName & s
         Name fPath & "\" & fName As fPath & "\" & newName
       End If
       fName = Dir
    Loop
End Sub
 

cmunoziii

New Member
Joined
Sep 22, 2013
Messages
6
Thanks Patel45! The code you pasted has certainly been a steer in the right direction. I'm going to continue working on it and then I will paste the code for everyone's use.
 

cmunoziii

New Member
Joined
Sep 22, 2013
Messages
6
Thanks again for posting the code that you did Patel45. I was able to use it and come up with my solution. Here is the code for anyone that might need to do something similar:

Sub RenAllFilesInclSubFold()

Dim fso As Object, fold As Object, fFile As Object
Dim fPath As String, fName As String, newName As String

fPath = "C:\mainFolder" ' ----- initial folder that contains all the subfolders
cnt = ""

'ren files in subfolders
Set fso = CreateObject("Scripting.FileSystemObject")
Set fold = fso.GetFolder(fPath)


For Each fFile In fold.subfolders
cnt = ""

'the files i want to rename and move, start with "Z1"
fName = Dir(fFile.Path & "\Z1*", vbNormal)

Do While fName <> ""
newName = "\myNewFileName & ".xls" 'or any ext you want
Name fFile.Path & "\" & fName As fFile.Path & newName
fso.MoveFile Source:=fFile.Path & newName, Destination:="C:\newFolder" 'this code will not create the new folder
fName = Dir
cnt = cnt & "i" 'just in case i have more than 1 Z1 file in a folder
Loop
Next
End Sub
 
Last edited:

Forum statistics

Threads
1,082,478
Messages
5,365,789
Members
400,850
Latest member
Raj_Jpr

Some videos you may like

This Week's Hot Topics

Top