Loop through a folder and rename the files

Keala

New Member
Joined
Jul 9, 2018
Messages
37
I'm kind of new to VBA and wonder if there is a easy way to loop through a folder with let say 300 files add a letter in alphabetic order at the beginning of each file name. So if the file name is "Vpp_vs_Freq_at_PC-10.0_KKC-2.0_180817-143105" change the name to "A_Vpp_vs_Freq_at_PC-10.0_KKC-2.0_180817-143105", next to "B_Vpp_vs_Freq_at_AC-10.0_DC-2.0_180817-143108" and so on when it reach Z add ZA and so on until next time reach Z then add ZZA...

I have search for some hints but not really been able to find anything which matches what I'm looking for. I will appreciate if you can give me a suggestion or a direction where I can find the right information.

Thank you
 
This gets over that hurdle. File names are added to a collection first and renamed from there
- this time using Z , ZZ, ZZZ :)

Code:
Sub RenameFiles()
    Const fPath = "C:\Folder\SubFolder\"                 [COLOR=#ff0000]'end path with "\"[/COLOR]
    Dim a As Long, z As String, myFile As String
    Dim coll As New Collection, f As Variant
    myFile = Dir(fPath & "*.*")
    a = 0: z = ""
    Do While myFile <> ""
        coll.Add myFile
        myFile = Dir
    Loop
    For Each f In coll
        If a = 26 Then a = 1 Else a = a + 1
        Name fPath & f As fPath & z & Split(Cells(1, a).Address, "$")(1) & "_" & f
        If a = 26 Then z = "Z" & z
    Next
End Sub
 
Upvote 0

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Thank you everyone for your suggestions. John_w suggestion is the most like what I want to achieve. But unfortunately something happens with the code when it reaches Z then the file names become:

ZZ_Waveform_Bursts-55_Freq-152.0_PC-30.0_KKC-6.0_180817-170846
ZZZ_Waveform_Bursts-55_Freq-153.0_PC-20.0_KKC-10.0_180817-190524
ZZZZ_W_Waveform_Bursts-55_Freq-152.0_PC-30.0_KKC-16.0_180817-223256
ZZZZZ_ZX_Waveform_Bursts-55_Freq-153.0_PC-10.0_KKC-6.0_180817-164250
ZZZZZZ_ZZZB_Y_Waveform_Bursts-55_Freq-152.0_PC-30.0_KKC-4.0_180817-160350
ZZZZZZZ_ZZZZD_ZZD_Waveform_Bursts-55_Freq-153.0_PC-20.0_KKC-2.0_180817-144616
ZZZZZZZZ_ZZZZZF_ZZZH_ZF_Waveform_Bursts-55_Freq-152.0_PC-40.0_KKC-2.0_180817-151202
.
.
.
last file
ZZZZZZZZZZZZZZZZZZZT_ZZZZZZZZZZZZZZZZZY_ZZZZZZZZZZZZZZZZA_ZZZZZZZZZZZZZZZA_ZZZZZZZZZZZZZX_ZZZZZZZZZZZQ_ZZZZZZZZZE_ZZZZZZZO_ZZZZZV_ZZV_Waveform_Bursts-55_Freq-153.0_PC-40.0_KKC-6.0_180817-172152

What I want to do as you state is A_, B_, ... Z_, then ZA_, ZB_, ... ZZ_, then ZZA_ etc. Could you please let me know what need to be changed for improving the code? Further by end a popup with Run-time '53' appears with text "File not found" and reference it to the line "Name path & filename As path & String(n \ 26, "Z") & Chr(n Mod 26 + 65) & "_" & filename"?

Thank you for the clarifications.
Sorry, I only tested my code on a folder containing 30 odd files and it worked correctly. I have reproduced the problem above and I think Yongle's diagnosis is correct.

Try this macro instead:

Code:
Public Sub Rename_Files_in_Folder()

    Dim path As String, filename As String
    Dim n As Long
    Dim files() As String
   
    path = "C:\path\to\folder\"               'MODIFY THIS LINE - FOLDER CONTAINING FILES TO BE RENAMED
    
    If Right(path, 1) <> "\" Then path = path & "\"
    n = 0
    filename = Dir(path & "*.*")
    Do While filename <> vbNullString
        ReDim Preserve files(n)
        files(n) = filename
        filename = Dir
        n = n + 1
    Loop

    For n = 0 To UBound(files)
        Name path & files(n) As path & String(n \ 26, "Z") & Chr(n Mod 26 + 65) & "_" & files(n)
    Next
    
End Sub
 
Upvote 0
Sorry, I just notice it does almost what I want it to do. It give the files the letter at the beginning but it look at the file name and set the letter according to the file name which is not what I want to do.
I have a folder with files such as "Waveform_Freq-147.0_PC-40.0_KKC-2.0_180817-151114", "Waveform_Freq-147.0_PC-40.0_KKC-4.0_180817-151114" and so on only KKC parameter is changed until 16. And this is the order I want it to keep. What the code does is that it select "Waveform_Freq-147.0_PC-40.0_KKC-10.0_180817-193021" and give it letter A then give letter B to "Waveform_Freq-147.0_PC-40.0_KKC-12.0_180817-193021" until 16 then it returns and give letter E to "Waveform_Freq-147.0_PC-40.0_KKC-2.0_180817-151114".
I want to keep the order as it is in the folder so take the first file in the folder give it A second B and so on without looking at the file names.

Sorry that I was not clear in first explanation. Hope you can give some suggestion on how to keep the folder order regardless of the name.
 
Upvote 0
Sounds very confusing :confused:
Probably easier for you to deal with this in a worksheet

- Create a new workbook and add the code below
- Amend the file path (remember to end path with " \ " )
- run ListFiles which creates a list of file names in column A
- put the correct new file names in column B (perhaps you can use a formula to help with this)
- run RenameThem

Code:
Const fPath = "C:\folder\subfolder[COLOR=#ff0000][B]\[/B][/COLOR]"
Sub [I]ListFiles[/I]()
    Dim myFile As String, r As Long
    myFile = Dir(fPath & "*.*")
    ActiveSheet.Range("A1:B1").Value = Array("OLD NAME", "NEW NAME")
    r = 2
    Do While myFile <> ""
        r = r + 1
        ActiveSheet.Cells(r, 1) = myFile
        myFile = Dir
    Loop
End Sub

Sub [I]RenameThem[/I]()
    Dim oldName As Range
    With ActiveSheet
        For Each oldName In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Name fPath & oldName As fPath & oldName.Offset(, 1)
        Next
    End With
End Sub

Good luck :)
 
Last edited:
Upvote 0
I want to keep the order as it is in the folder so take the first file in the folder give it A second B and so on without looking at the file names.

Sorry that I was not clear in first explanation. Hope you can give some suggestion on how to keep the folder order regardless of the name.
This problem is caused by the Dir function returning file names in alphabetical order (e.g. File_1, File_10, File_11, File_2, File_9), whereas you want them in numerical order (e.g. File_1, File_2, File_9, File_10, File_11). I checked the FileSystemObject folder.files collection and that also has the file names in alphabetical order.

We therefore need to sort the array of files, but using the StrCmpLogicalW Windows API function to compare (Unicode) strings numerically to put the file names in the same order as File Explorer.

Code:
'StrCmpLogicalW function
'https://docs.microsoft.com/en-us/windows/desktop/api/shlwapi/nf-shlwapi-strcmplogicalw
'
'Compares two Unicode strings. Digits in the strings are considered as numerical content rather than text. This test is not case-sensitive.
'Returns zero if the strings are identical.
'Returns 1 if string1 has a greater value than string2.
'Returns -1 if string1 has a lesser value than string2.

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi.dll" (ByVal string1 As String, ByVal string2 As String) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function StrCmpLogicalW Lib "shlwapi.dll" (ByVal string1 As String, ByVal string2 As String) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Public Sub Rename_Files_in_Folder()

    Dim path As String, filename As String
    Dim n As Long, m As Long
    Dim files() As String, swap As String
    
    path = "C:\path\to\folder"               'MODIFY THIS LINE - FOLDER CONTAINING FILES TO BE RENAMED
    
    If Right(path, 1) <> "" Then path = path & ""
    n = 0
    filename = Dir(path & "*.*")
    Do While filename <> vbNullString
        ReDim Preserve files(n)
        files(n) = filename
        filename = Dir
        n = n + 1
    Loop

    'Bubble sort files array, calling StrCmpLogicalW to compare Unicode strings numerically to sort the file names in
    'the same order as File Explorer
    
    For m = 0 To UBound(files) - 1
        For n = m + 1 To UBound(files)
            If StrCmpLogicalW(StrConv(files(m), vbUnicode), StrConv(files(n), vbUnicode)) = 1 Then
                'files(m) > files(n) so swap them
                swap = files(n)
                files(n) = files(m)
                files(m) = swap
            End If
        Next
    Next
    
    For n = 0 To UBound(files)
        Name path & files(n) As path & String(n \ 26, "Z") & Chr(n Mod 26 + 65) & "_" & files(n)
    Next
    
End Sub
Note: I've used a simple Bubble Sort to sort the files array. If you find this is a bit slow then the code could be changed to use a faster sort algorithm.
 
Upvote 0
Great, Thank you John_w for the code and your effort, this is exactly what I want to do. Highly appreciated. As well thank you Yongle your suggestions I have learned more VBA from these.
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top