What is the best way to do the following:

500 excel files are in a folder. I need to rename each one as:
"lbif08" & first 5 digits of Cell A1 of each file &".xls"

Note: I don't need to keep the original file name.

Please help!!! Thank you!

Use the Name command. Format:
Name oldpathname As newpathname

This assumes none of the New names will conflict with existing names.

Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long

' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"

sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & bk.Worksheets( _
1).Range("A1").Text & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

--
Regards,
Tom Ogilvy



"Filo" wrote in message
...
What is the best way to do the following:

500 excel files are in a folder. I need to rename each one as:
"lbif08" & first 5 digits of Cell A1 of each file &".xls"

Note: I don't need to keep the original file name.

Please help!!! Thank you!

I missed the first 5 characters. Here is a revision:

Option Explicit
Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long
' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"
sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & Left(bk.Worksheets( _
1).Range("A1").Text,5) & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

I assume the first 5 digits are the first 5 characters in the cell.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Use the Name command. Format:
Name oldpathname As newpathname

This assumes none of the New names will conflict with existing names.

Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long

' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"

sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & bk.Worksheets( _
1).Range("A1").Text & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

--
Regards,
Tom Ogilvy



"Filo" wrote in message
...
What is the best way to do the following:

500 excel files are in a folder. I need to rename each one as:
"lbif08" & first 5 digits of Cell A1 of each file &".xls"

Note: I don't need to keep the original file name.

Please help!!! Thank you!

Filo,
It looks like Tom left out one line of code within the Do While loop. Make
the end of it look like this and see how things go:

ReDim Preserve OldName(1 to i)
Redim Preserve NewName(1 to i)
sName=Dir()
Loop

You said that it didn't do anything? I'm betting it went into a perpetual
loop? And it probably actually did work for one file.

"Filo" wrote:

Tom,

When I tried the program, it didn't work. IT runs but it doesn't perform
anything. Could you check what may be wrong please?

Thank you.

Filo

"Tom Ogilvy" wrote:

I missed the first 5 characters. Here is a revision:

Option Explicit
Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long
' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"
sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & Left(bk.Worksheets( _
1).Range("A1").Text,5) & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

I assume the first 5 digits are the first 5 characters in the cell.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Use the Name command. Format:
Name oldpathname As newpathname

This assumes none of the New names will conflict with existing names.

Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long

' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"

sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & bk.Worksheets( _
1).Range("A1").Text & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

--
Regards,
Tom Ogilvy



"Filo" wrote in message
...
What is the best way to do the following:

500 excel files are in a folder. I need to rename each one as:
"lbif08" & first 5 digits of Cell A1 of each file &".xls"

Note: I don't need to keep the original file name.

Please help!!! Thank you!

Tom,

When I tried the program, it didn't work. IT runs but it doesn't perform
anything. Could you check what may be wrong please?

Thank you.

Filo

"Tom Ogilvy" wrote:

I missed the first 5 characters. Here is a revision:

Option Explicit
Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long
' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"
sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & Left(bk.Worksheets( _
1).Range("A1").Text,5) & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

I assume the first 5 digits are the first 5 characters in the cell.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Use the Name command. Format:
Name oldpathname As newpathname

This assumes none of the New names will conflict with existing names.

Sub RenameFiles()
Dim OldName() As String
Dim NewName() As String
Dim bk As Workbook
Dim sPath As String, sName As String
Dim i As Long, j As Long

' change to reflect your directory
sPath = "C:\Myfolder\Myfiles\"

sName = Dir(sPath & "*.xls")
ReDim OldName(1 To 1)
ReDim NewName(1 To 1)
i = 1
Do While sName < ""
OldName(i) = sName
Set bk = Workbooks.Open(sPath & sName)
NewName(i) = "lbif08" & bk.Worksheets( _
1).Range("A1").Text & ".xls"
bk.Close SaveChanges:=False
i = i + 1
ReDim Preserve OldName(1 To i)
ReDim Preserve NewName(1 To i)
Loop
For j = 1 To i - 1
Name sPath & OldName(i) As sPath & NewName(i)
Next
End Sub

--
Regards,
Tom Ogilvy



"Filo" wrote in message
...
What is the best way to do the following:

500 excel files are in a folder. I need to rename each one as:
"lbif08" & first 5 digits of Cell A1 of each file &".xls"

Note: I don't need to keep the original file name.

Please help!!! Thank you!