Excel VBA - Loop through folder and rename specific files

BigShango

Board Regular
Joined
May 8, 2014
Messages
106
Hi,

I've found a few solutions to similar problems but nothing that quite does what I need, or that I can manage to modify to do it.

VBA Code:
Set mb = ThisWorkbook
Set s = mb.Sheets(1)

path = s.Range("C1").Value
If Right(path, 1) <> "\" Then path = path & "\"

For r = 3 To LastRow(s, "B")
    If Not s.Range("C" & r).Value = "" Then
        name1 = s.Range("C" & r).Value
        'loop through each file in the path folder
        'if name1 within filename then
        'rename file to s.range("B" & r).value with original file extension
    End If
Next

This is what I have so far. I want to loop down column C - get the filenames from there. Then loop through a specified folder to find those file names and rename them to whatever is in column B. It should be fairly simple, there won't be many files in each folder and the filenames in column c will be exact (just missing the file extension). I'm struggling with looping through the folder and renaming the files.

Edit - I should add, these file could be anything from .oft to .pdf to .html, so I don't want to open them and save them with the new filename - I just want to rename them if possible.

Any help would be great. Thanks.
 
Last edited:

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
You want to check if file exists and if it does, then change it name. Try this, should work perfectly.
VBA Code:
Dir FileName as String
FileName = vba.filesystem.dir("Path of the folder" & File name that you should get from loop)
if FileName = vba.constants.vbnullstring then
'do nothing or whatever you want to do if it does not exist
else
workbooks.open "path of the folder" & file name from loop
workbooks.saveas "path of the folder" & new file name from loop
end if
 
Upvote 0
Thanks for the help, that's not quite what I'm after though.

I need to check if a file with that name exists and rename it to my new name including the original file extension. So I'm going to search a folder for "My Old File" and if it finds "My Old File.pdf" it will rename it to "My New File.pdf", if it finds "My Old File.html" it will rename it to "My New File.html". They usually won't be .xlsx files so I can't open and saveas, I'm hoping it's possible to just rename the files.

I realise that using Excel and VBA maybe isn't the best way to do this but it's the only way I can, I can't install anything on this computer.
 
Upvote 0
Thanks! It's not urgent at all. It's a tedious task I'm doing that I'm trying to speed up a bit

To give a bit more background, I've got a fixed list of the new file names down Column B. These never change, they might as well be "1. New File", "2. New File" etc. I then have folders full of wrongly named files (with all sorts of different file extensions) that I need to match up with these, so my plan is to paste in the existing file name next to the correct ones, tell it which folder I'm in then run it to change them to the correct file names while maintaining whatever file type they originally were.

So in the end I'll have renamed "random wrong filename.pdf" to "1. New File.pdf" and "random wrong filename 2.xlsx" to "2. New File.xlsx" etc. In the next folder I might be renaming "random wrong filename.html" to "1. New File.html" and "random wrong filename 2.doc" to "2. New File.doc"

Hope that makes sense :)
 
Upvote 0
Okey, so I got 2 subs for you. The first one will allow you to choose files to rename and list them in column A.
The second one will actually rename them after you provide names in column B. You only need to write down names without extentions. Will that work for you?
1. You run the first SUB.
VBA Code:
Sub FileNametoExcel1()
    
    Dim fnam As Variant
    ' fnam is an array of files returned from GetOpenFileName
    ' note that fnam is of type boolean if no array is returned.
    ' That is, if the user clicks on cancel in the file open dialog box, fnam is set to FALSE
    
    Dim b As Integer 'counter for filname array
    Dim b1 As Integer 'counter for finding \ in filename
    Dim c As Integer 'extention marker
    
    ' format header
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Path and Filenames that had been selected to Rename"
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
    End With
    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Input New Filenames Below"
    Range("B1").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
    End With
    Columns("B:B").EntireColumn.AutoFit
    
    ' first open a blank sheet and go to top left  ActiveWorkbook.Worksheets.Add
    
    fnam = Application.GetOpenFilename("all files (*.*), *.*", 1, _
    "Select Files to Fill Range", "Get Data", True)
    
    If TypeName(fnam) = "Boolean" And Not (IsArray(fnam)) Then Exit Sub
    
    'if user hits cancel, then end
    
    For b = 1 To UBound(fnam)
        ' print out the filename (with path) into first column of new sheet
        ActiveSheet.Cells(b + 1, 1) = fnam(b)
    Next
    
    
End Sub

2. You get this result shown below.

2020-04-15_18h52_42.png
2020-04-15_18h52_54.png

3. Type in the names you want.
2020-04-15_18h55_05.png

4. Run the second SUB.
VBA Code:
Sub RenameFile()
    Dim z As String
    Dim s As String
    Dim V As Integer
    Dim TotalRow As Integer
    
    TotalRow = ActiveSheet.UsedRange.Rows.Count
    
    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 = z
        Dim PosFileExtention As Long
        PosFileExtention = InStrRev(sOldPathName, ".") - 1
        Dim FileExtenion As String
        Dim Lenght As Long
        Lenght = Len(sOldPathName)
        FileExtention = Right(sOldPathName, Lenght - PosFileExtention)
        On Error Resume Next
        Name sOldPathName As s & FileExtention
        
    Next V
    
    MsgBox "Congratulations! You have successfully renamed all the files"
    
End Sub
4. You will get this and expected result :)
2020-04-15_18h55_15.png
2020-04-15_18h55_21.png
 
Upvote 0
Excellent. I'll need to modify it slightly to get it do what I want but that's got the parts I need. The file select is a good idea, I hadn't considered that.

Thanks very much.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

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