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