Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files Problem Continued
I tried the program below but I wasn't able to make it rename the files and
it doesn't loop. Could you please test it, and let me know if there is anything that should be changed? My problem was: 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" 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files Problem Continued
Test the following adjusted code on a separate folder with a limited number
of copied files. Minimal testing:- 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 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 sName = Dir() ReDim Preserve OldName(1 To i) ReDim Preserve NewName(1 To i) Loop While sName < "" For j = 1 To i - 1 Name sPath & OldName(j) As sPath & NewName(j) Next End Sub Regards, Greg "Filo" wrote: I tried the program below but I wasn't able to make it rename the files and it doesn't loop. Could you please test it, and let me know if there is anything that should be changed? My problem was: 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" 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files Problem Continued
Thanks for the feedback. Tom did 98% of the work. If he didn't you probably
wouldn't have received an answer. Greg "Filo" wrote: Greg, You made my day. Thank you!!!! "Greg Wilson" wrote: Test the following adjusted code on a separate folder with a limited number of copied files. Minimal testing:- 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 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 sName = Dir() ReDim Preserve OldName(1 To i) ReDim Preserve NewName(1 To i) Loop While sName < "" For j = 1 To i - 1 Name sPath & OldName(j) As sPath & NewName(j) Next End Sub Regards, Greg "Filo" wrote: I tried the program below but I wasn't able to make it rename the files and it doesn't loop. Could you please test it, and let me know if there is anything that should be changed? My problem was: 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" 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files Problem Continued
Greg, You made my day. Thank you!!!!
"Greg Wilson" wrote: Test the following adjusted code on a separate folder with a limited number of copied files. Minimal testing:- 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 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 sName = Dir() ReDim Preserve OldName(1 To i) ReDim Preserve NewName(1 To i) Loop While sName < "" For j = 1 To i - 1 Name sPath & OldName(j) As sPath & NewName(j) Next End Sub Regards, Greg "Filo" wrote: I tried the program below but I wasn't able to make it rename the files and it doesn't loop. Could you please test it, and let me know if there is anything that should be changed? My problem was: 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" 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Renaming Files | Excel Programming | |||
Range Problem #2 (continued) | Excel Programming | |||
Renaming Zip files | Excel Programming | |||
Renaming Files | Excel Programming | |||
Renaming Files | Excel Programming |