need macro for renaming bunch of excel files

Basically I have a bunch of excel files in the same folder as my main spreadsheet, all with different names.

What I want to do is have a macro in my main excel spreadsheet (which is named "EPPR External Timesheets Summary Template.xls") which will take ALL excel files inside the same folder as my main excel spreadsheet and rename them sequentially to EX1.xls, EX2.xls, EX3.xls.... etc up to EX40.xls (any more than 40 files then the ramainder will be ignored.

It doesnt matter which files get renamed in which order as long as they start at EX1 and end at either the last file, or EX40 if theres more than 40 files.

So from what I can see it needs to

count the total number of .xls files in the same folder as the main spreadsheet which contains the macro.

Take one from this total (as we do not include my main spreadsheet which will contain this macro) to give the total number of files that need renaming.

Rename these files (EXCLUDING my main spreadsheet) to EX1.xls etc etc until they are all done, or until we hit EX40.

Would be extremely useful if someone has something like this already as it would save me a load of time having to rename these files manually.

Thanks

Somthing like this should do it:


Function GetFilesInFolder(FileSpec As String) As Variant

'Returns an array of filenames that match FileSpec
'If no matching files are found, it returns False
'-----------------------------------------------------

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

'Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop

GetFilesInFolder = FileArray

Exit Function

'Error handler
NoFilesFound:
GetFilesInFolder = False
On Error GoTo 0

End Function


Sub RenameFiles(strFolder As String, _
strExtension As String, _
strFileExclude As String, _
strNewName As String, _
lMaxFiles As Long, _
Optional bKillOld As Boolean = False)

Dim arr
Dim i As Long
Dim lCounter As Long

On Error GoTo ERROROUT

arr = GetFilesInFolder(strFolder & "\*." & strExtension)

For i = 1 To UBound(arr)
If arr(i) <> strFileExclude And _
lCounter < lMaxFiles Then
FileCopy strFolder & "\" & arr(i), _
strFolder & "\" & strNewName & lCounter + 1 & "." &
strExtension
lCounter = lCounter + 1
If bKillOld Then
Kill strFolder & "\" & arr(i)
End If
End If
Next

Exit Sub
ERROROUT:

MsgBox "no files found", , "rename files in folder"
On Error GoTo 0

End Sub


Sub Test()

RenameFiles "C:\ExcelFiles", _
"xls", _
"NotThisOne.xls", _
"EX", _
40

End Sub


RBS



"neowok" <[email protected]> wrote in
message news:[email protected]...
>
> Basically I have a bunch of excel files in the same folder as my main
> spreadsheet, all with different names.
>
> What I want to do is have a macro in my main excel spreadsheet (which
> is named "EPPR External Timesheets Summary Template.xls") which will
> take ALL excel files inside the same folder as my main excel
> spreadsheet and rename them sequentially to EX1.xls, EX2.xls,
> EX3.xls.... etc up to EX40.xls (any more than 40 files then the
> ramainder will be ignored.
>
> It doesnt matter which files get renamed in which order as long as they
> start at EX1 and end at either the last file, or EX40 if theres more
> than 40 files.
>
> So from what I can see it needs to
>
> count the total number of .xls files in the same folder as the main
> spreadsheet which contains the macro.
>
> Take one from this total (as we do not include my main spreadsheet
> which will contain this macro) to give the total number of files that
> need renaming.
>
> Rename these files (EXCLUDING my main spreadsheet) to EX1.xls etc etc
> until they are all done, or until we hit EX40.
>
> Would be extremely useful if someone has something like this already as
> it would save me a load of time having to rename these files manually.
>
> Thanks
>
>
> --
> neowok
> ------------------------------------------------------------------------
> neowok's Profile:
> http://www.excelforum.com/member.php...fo&userid=5940
> View this thread: http://www.excelforum.com/showthread...hreadid=394886
>

thanks, I have found a shorter solution which is

Sub renfiles()
Dim I As Long
Dim NoFiles As Long
Dim strOldName As String
Dim strNewName As String

With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
.Execute
NoFiles = IIf(.FoundFiles.Count > 40, 40, .FoundFiles.Count - 1)

For I = 0 To NoFiles
If .FoundFiles(I + 1) <> ThisWorkbook.FullName Then
strOldName = .FoundFiles(I + 1)
strNewName = ThisWorkbook.Path & "\EX" & Format(I + 1, "0") & ".xls"
Name strOldName As strNewName
End If
Next I
End With

End Sub

the only problem I have with this one at the moment is if an ex1 etc file already exists when it tries to rename a file to ex1 then it causes a runtime error, when it should rename it to ex2 instead if ex1 already exists.

thanks

The Filesearch method is less code, but it is slower and it relies on a
reference to the
Filesearch library, so I prefer my method.
To avoid an error and make the added number one higher I made a small
adaptation:


Sub RenameFiles(strFolder As String, _
strExtension As String, _
strFileExclude As String, _
strNewName As String, _
lMaxFiles As Long, _
Optional bKillOld As Boolean = False)

Dim arr
Dim i As Long
Dim lCounter As Long
Dim lCounterAdd As Long

On Error GoTo ERROROUT

arr = GetFilesInFolder(strFolder & "\*." & strExtension)

For i = 1 To UBound(arr)
If arr(i) <> strFileExclude And _
lCounter < lMaxFiles Then

Do While Len(Dir(strFolder & "\" & _
strNewName & lCounter + 1 + lCounterAdd & _
"." & strExtension)) > 0
lCounterAdd = lCounterAdd + 1
Loop

FileCopy strFolder & "\" & arr(i), _
strFolder & "\" & strNewName & lCounter + 1 +
lCounterAdd & "." & strExtension
lCounter = lCounter + 1

If bKillOld Then
Kill strFolder & "\" & arr(i)
End If

End If
Next

Exit Sub
ERROROUT:

MsgBox "no files found", , "rename files in folder"
On Error GoTo 0

End Sub


RBS


"neowok" <[email protected]> wrote in
message news:[email protected]...
>
> thanks, I have found a shorter solution which is
>
> Sub renfiles()
> Dim I As Long
> Dim NoFiles As Long
> Dim strOldName As String
> Dim strNewName As String
>
> With Application.FileSearch
> NewSearch
> LookIn = ThisWorkbook.Path
> FileType = msoFileTypeExcelWorkbooks
> Execute
> NoFiles = IIf(.FoundFiles.Count > 40, 40, .FoundFiles.Count -
> 1)
>
> For I = 0 To NoFiles
> If .FoundFiles(I + 1) <> ThisWorkbook.FullName Then
> strOldName = .FoundFiles(I + 1)
> strNewName = ThisWorkbook.Path & "\EX" & Format(I + 1,
> "0") & ".xls"
> Name strOldName As strNewName
> End If
> Next I
> End With
>
> End Sub
>
> the only problem I have with this one at the moment is if an ex1 etc
> file already exists when it tries to rename a file to ex1 then it
> causes a runtime error, when it should rename it to ex2 instead if ex1
> already exists.
>
> thanks
>
>
> --
> neowok
> ------------------------------------------------------------------------
> neowok's Profile:
> http://www.excelforum.com/member.php...fo&userid=5940
> View this thread: http://www.excelforum.com/showthread...hreadid=394886
>