renaming multiple excel files

[pauliethegull]

Hi,

Feeling about foolish as at my age your suppose to know these things.......

Anyway, Im trying to create a folder with 4200 excel files, the files are identical but I need to name the files numerically, ie: start at 2300 and end at 6500. I am presently renaming them individually which is taking ages.

Is there anyway I can change the name of them quicker?

Thanks

 

[daverunt]

Thanks Ruddles works a treat - now the next couple of days to figure out how it works....

 

[Ruddles]

Maybe this commented version will help. (This version also has a file count at the end.)

[FONT=Courier New][SIZE=1]Option Explicit
 
Sub LoopThroughFolder()
 
  Const MyPath As String = "[COLOR=red][B]C:\TEMP\[/B][/COLOR]"     [/SIZE][/FONT][SIZE=1][FONT=Courier New][COLOR=green]' where to find the files
[/COLOR]  Const MyRoot As String = "[COLOR=red][B]newfilename[/B][/COLOR]"  [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' what to call the files
[/COLOR]  Const FileSpec As String = "[B][COLOR=red]*.xls*[/COLOR][/B]"     [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' which files to rename
[/COLOR]  Const SequenceStart As Long = [COLOR=red][B]4200[/B][/COLOR]      [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' where to start the sequence numbers
[/COLOR]  
  Dim MyFile As String
  Dim FileRoot As String
  Dim FileExt As String
  Dim SequenceNo As Integer
  Dim iDot As Integer
  
 [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green] ' start the sequence numbering here
[/COLOR]  SequenceNo = SequenceStart
 [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green] ' get the first filename with the required path & filespec
[/COLOR]  MyFile = Dir(MyPath & FileSpec)
  [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' loop through file names until they run out
[/COLOR]  Do While Len(MyFile) > 0
    [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' look for the last dot so we can extract file extension
[/COLOR]    iDot = InStrRev(MyFile, ".")
    [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]' store the bit of the filename before the ddot - this is the bit we need to rename
[/COLOR]    FileRoot = Left(MyFile, iDot - 1)
   [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green] ' and store the file extension so we can reassemble the name later
[/COLOR]    FileExt = Mid(MyFile, iDot + 1)
   [/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=green] ' if the last bit of the filename is already four digits, it may be just happen to be that or it
    ' may be left over[/COLOR][/SIZE][/FONT][SIZE=1][FONT=Courier New][COLOR=green] from a previous run - rename it so it doesn't screw up our sequence numbering
[/COLOR]    If IsNumeric(Right(FileRoot, 4)) Then
      Name MyPath & MyFile As MyPath & FileRoot & Right(FileRoot, 4) & "." & FileExt
      FileRoot = FileRoot & Right(FileRoot, 4)
    End If
   [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green] ' now rename the file with the sequence number added to the bit before the dot
[/COLOR]    Name MyPath & FileRoot & "." & FileExt As MyPath & MyRoot & CStr(SequenceNo) & Mid(MyFile, iDot)
[/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]    ' go get the next file
[/COLOR]    MyFile = Dir
[/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=green]    ' increment the sequence number in readiness for the next file
[/COLOR]    SequenceNo = SequenceNo + 1
  Loop
  
[/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=blue][B]  MsgBox (SequenceNo - SequenceStart) & " files renamed" & Space(10), vbOKOnly + vbInformation
[/B][/COLOR]    
End Sub[/FONT][/SIZE]

 

[daverunt]

Brilliant - thanks for that.