Rename Excel files in folder with VBA

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:

Code:

---

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

---

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

This code works? What is your question?

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

Code:

---

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

---

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'.

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

Code:

---

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.

Code:

---

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.

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

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

Code:

---

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

---

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.

Code:

---

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

---

I have added the Excel file.

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.Attachment 31404

I think you missed some things

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

Code:

---

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

---

This is working. Many thanks Paul!