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

[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!