Rename Excel files in folder with VBA

[MathiasDW87]

Hi all,

I'm trying to create a macro that automatically changes the name of all files in a given folder. For the moment I was able to create a code that lists all files in a specific folder. Then I was able to change the filenames, but only one by one. I suppose there is a shorter way of doing this. As it might be that there are more than 30 files in this folder.

PART 1: list excel files:

Public Sub ListFilesInFolder()
    'Variable Declaration
    Dim strPath As String
    Dim vFile As Variant
    Dim iCurRow As Integer
    'Clear old data
    Blad1.Range("B9:B1000").ClearContents
    'Set the path of the folder
    strPath = Blad1.Range("B4").Value
    'Add slash at the end of the path
    If Right(strPath, 1) <> "/" And Right(strPath, 1) <> "" Then
        strPath = strPath & ""
    End If
    'Set Directory to folder path
    ChDir strPath
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    iCurRow = 9
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Blad1.Cells(iCurRow, 2).Value = vFile
        vFile = Dir
        iCurRow = iCurRow + 1
    Loop

PART 2: change name

Sub vba_rename_workbook()
Range("B20") = Range("B4") & "" & Range("B9")
Range("C20") = Range("B4") & "" & Range("C9")
Dim oldName1 As String
Dim newName1 As String
oldName1 = Range("B20")
newName1 = Range("C20")
Range("B21") = Range("B4") & "" & Range("B10")
Range("C21") = Range("B4") & "" & Range("C10")
Dim oldName2 As String
Dim newName2 As String
oldName2 = Range("B21")
newName2 = Range("C21")
Range("B22") = Range("B4") & "" & Range("B11")
Range("C22") = Range("B4") & "" & Range("C11")
Dim oldName3 As String
Dim newName3 As String
oldName3 = Range("B20")
newName3 = Range("C20")
Name oldName1 As newName1
Name oldName2 As newName2
Name oldName3 As newName3
End Sub

[June7]

Please post code between CODE tags to retain indentation and readability.

This code works? What is your question?

[Paul_Hossler]

Welcome to yhr forum. Please take a minute to read the FAQ at the line in my signature. Especially the parts about multi-posting and using CODE tags

I added them to your post this time

Now ...

Does your code work? Seems to missing some things

1. At least in US version it's a back slacsh \ not a /

2. I don't see the need for adding or testing for what seems to be empty strings ("") unless there's a space there that I missed

3, The For i = loop should rename files

This is NOT tested so you'll probably have to tweak it

Option Explicit


Public Sub FilesInFolder()
    'Variable Declaration
    Dim strPath As String
    Dim vFile As Variant
    Dim iCurRow As Long, i As Long
    Dim oldName1 As String, newName1 As String


    'Clear old data
    Blad1.Range("B9:B1000").ClearContents
    
    'Set the path of the folder
    strPath = Trim(Blad1.Range("B4").Value)
    
    'Add slash at the end of the path
    If Right(strPath, 1) <> Application.PathSeparator Then
        strPath = strPath & Application.PathSeparator
    End If
    
    'Set Directory to folder path
    ChDir strPath
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    iCurRow = 9
    
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Blad1.Cells(iCurRow, 2).Value = vFile
        vFile = Dir
        iCurRow = iCurRow + 1
    Loop


    For i = 9 To iCurRow - 1
        oldName1 = Trim(strPath & Range("B" & i).Value)
        newName1 = Trim(strPath & Range("C" & i).Value)
    
        Name oldName1 As newName1
    Next i


End Sub

[snb]

You don't tell in what way filenames should be altered.

Is it the extension or the text before the extension.
Is there a pattern in de filanems and teh way the should be altered.

In DOS you will find the most fundamental command to change filenames: 'REN'.

[MathiasDW87]

So this is the first part of the code which is working (macro linked to button 'List files in folder')

Sub FilesInFolder()    
    'Variable Declaration
    Dim strPath As String
    Dim vFile As Variant
    Dim iCurRow As Long, i As Long
    Dim oldName1 As String, newName1 As String

    'Set Directory to folder path
    ChDir strPath
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    iCurRow = 9
    
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Blad1.Cells(iCurRow, 2).Value = vFile
        vFile = Dir
        iCurRow = iCurRow + 1
    Loop

    For i = 9 To iCurRow - 1
        oldName1 = Trim(strPath & Range("B" & i).Value)
        newName1 = Trim(strPath & Range("C" & i).Value)
        Name oldName1 As newName1
    Next i
End Sub

For the second part (I will link it to the other button) I would like to rename the old filenames (which are mentioned now in cells B9, B10, B11, B12,...) to the new filenames (column C9, C10, C11, C12,...). I want to do that for all Excel files in the folder path in cell B4.

[snb]

Sub M_snb()
  sn=sheet1.usedrange

  for j=9 to ubound(sn)
     name sn(4,2) & "\" & sn(j,2) As sn(4,2) & "\" & sn(j,3)
  next
End Sub

NB. Automation is meant to simplify things not to overcomplicate.

[MathiasDW87]

This does not work unfortunately... I changed Sheet1 to Blad1 because I use Dutch version.

[Paul_Hossler]

I didn't see where you put anything into strPath

But I think you need to breakout the For i = loop into a seperate sub if you want a button for that

Option Explicit


Dim iCurRow As Long


Sub FilesInFolder()
    'Variable Declaration
    Dim strPath As String
    Dim vFile As Variant


    strPath = Sheet1.Range("B4") & Application.PathSeparator  '   <<<<<<<<<<<<<<<<<<<<<  Blad1


    'Set Directory to folder path
    ChDir strPath
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    iCurRow = 9
    
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Sheet1.Cells(iCurRow, 2).Value = vFile   '   <<<<<<<<<<<<<<<<<<<<<  Blad1
        vFile = Dir
        iCurRow = iCurRow + 1
    Loop
End Sub


Sub RenameFiles()
    Dim i As Long
    Dim oldName1 As String, newName1 As String
    
    For i = 9 To iCurRow - 1
        oldName1 = Trim(strPath & Range("B" & i).Value)
        newName1 = Trim(strPath & Range("C" & i).Value)
        Name oldName1 As newName1
    Next i
End Sub

[snb]

Then tell us what appears in the Msg box (you can also test it yourself).
Posting a picture is not a good idea: post an Excel example file.

Sub M_snb() 
  sn = Blad1.usedrange 

  for j = 9 to ubound(sn) 
    msgbox sn(4,2) & "\" & sn(j,2) & VBlf & sn(4,2) & " \" & sn(j,3) 
    name sn(4,2) & "\" & sn(j,2) As sn(4,2) & "\" & sn(j,3) 
  next 
End Sub

[MathiasDW87]

I have added the Excel file.

[MathiasDW87]

The first part is working, but the second part not. I have added the Excel file with the code you proposed for the second part.Macro BS recons.xlsm

[Paul_Hossler]

I think you missed some things

THis is not tested, but might be a better starting point

Option Explicit


Sub FilesInFolder()
    Dim vFile As Variant
    Dim iCurRow As Long
    Dim oldName1 As String, newName1 As String, strPath As String


    strPath = Blad1.Cells(4, 2).Value
    If Right(strPath, 1) <> Application.PathSeparator Then strPath = strPath & Application.PathSeparator
    
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    
    iCurRow = 8
    
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Blad1.Cells(iCurRow, 2).Value = vFile
        vFile = Dir
        If vFile <> "" Then
            iCurRow = iCurRow + 1
            Blad1.Cells(iCurRow, 2).Value = vFile
        End If
    Loop


End Sub


Sub RenameFiles()
    Dim iCurRow As Long
    Dim oldName1 As String, newName1 As String, strPath As String


    strPath = Blad1.Cells(4, 2).Value
    If Right(strPath, 1) <> Application.PathSeparator Then strPath = strPath & Application.PathSeparator
        
    iCurRow = 9
        
    Do While Blad1.Cells(iCurRow, 2).Value <> ""
        oldName1 = strPath & Blad1.Cells(iCurRow, 2).Value
        newName1 = strPath & Blad1.Cells(iCurRow, 3).Value
        
        Name oldName1 As newName1
        
        iCurRow = iCurRow + 1
    
    Loop
End Sub

[MathiasDW87]

This is working. Many thanks Paul!