PDA

View Full Version : Solved: Batch Renaming all files in a folder



rajkumar
10-19-2009, 05:06 PM
HI,

I want to rename all files in a chosen folder.

I have the file names in column A (to be renamed to new name) in a worksheet and another names in Column B (new name).

I was searching for the code and i got this from

http://www.astahost.com/info.php/Renaming-Files-Excel-Spreadsheet_t9785.html


Sub RenameFiles()
'Edit this variable to start the name search from a different row:
StartRow = 1
'Edit this variable to specify in which column the names are:
StartColumn = 1
'Edit this variable to look for a different string at the beginning of filenames
Match = "Budget"

'Define an FSO object
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject

'Create a variable to store the folder holding the files
Dim FilesDir As Folder
'Change the string here to look in a different folder (highly recommended :P)
Set FilesDir = FSO.GetFolder("C:\yotam\temp\renamefiles\test\")

'Define a counter variable and set it zero
Dim i As Integer
i = 0

'Loop through all of the files in the folder
Dim CurFile As File
For Each CurFile In FilesDir.Files

'If the file begins with the word "budget" then rename it
If LCase(Left(CurFile.Name, Len(Match))) = LCase(Match) Then

'Rename the file to the value in the specified cell
CurFile.Move FilesDir + "\" + Me.Cells(StartRow + i, StartColumn).Text
'Increment the counter so next time we will use a cell from the next row for naming
i = i + 1

End If

Next
End Sub


This macro does not have folder browsing and does not look at a specified workbook for file names.

How can i modify this to meet my requirement. can anybody help?

Raj

Bob Phillips
10-20-2009, 12:41 AM
Sub RenameFiles()
Dim FilesDir As String
Dim CurFile As String
Dim RowNum As Long

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
If .Show = -1 Then

FilesDir = .SelectedItems(1)
CurFile = Dir(FilesDir & Application.PathSeparator & "*")
Do Until CurFile = ""

RowNum = 0
On Error Resume Next
RowNum = Application.Match(CurFile, Range("A:A"), 0)
On Error GoTo 0
If RowNum > 0 Then

Name FilesDir & Application.PathSeparator & CurFile As _
FilesDir & Application.PathSeparator & Cells(RowNum, "B").Value
End If
CurFile = Dir
Loop
End If
End With
End Sub

rajkumar
10-20-2009, 08:47 AM
Excellent!!

Xld you are ultimate. thanks a lot

Raj :clap: :beerchug: