Chip

I found that your code did not add the text to the beginning of the original
filename as OP desired

I changed to...........

Sub RenameAll()

Const C_FOLDER_NAME = "C:\Test" '<<<< CHANGE THIS
Const C_WORD_TO_APPEND = "Test" '<<<< CHANGE THIS
Dim FName As String
Dim NewName As String
Dim Pos As Integer
ChDrive C_FOLDER_NAME
ChDir C_FOLDER_NAME
FName = Dir("*.xls") ' Change the *.xls to whatever file spec you need.
Do Until FName = vbNullString
NewName = C_WORD_TO_APPEND & FName
Name FName As NewName
FName = Dir()
Loop

End Sub

OK with you?


Gord Dibben MS Excel MVP

On Thu, 15 Feb 2007 18:46:42 -0600, "Chip Pearson" wrote:

Assuming that all files are in the same folder, and that the folder doesn't
contain files that you don't want to rename, use code like the following:

Sub RenameAll()

Const C_FOLDER_NAME = "C:\Test" '<<<< CHANGE THIS
Const C_WORD_TO_APPEND = "Test" '<<<< CHANGE THIS
Dim FName As String
Dim NewName As String
Dim Pos As Integer
ChDrive C_FOLDER_NAME
ChDir C_FOLDER_NAME
FName = Dir("*.xls") ' Change the *.xls to whatever file spec you need.
Do Until FName = vbNullString
Pos = InStrRev(FName, ".")
NewName = Left(FName, Pos - 1) & C_WORD_TO_APPEND & Mid(FName, Pos)
Name FName As NewName
FName = Dir()
Loop

End Sub