Does anyone have a macro that will rename excel files with text from
cell within the file

--
Message posted from http://www.ExcelForum.com

You would need a column with old names and a column with new names.

Assume old names are in column 1 and new names in column 2, with names
starting in row 1

sPath = "C:\Myfolder\"
for each cell in Range(Cells(1,2),Cells(1,2).End(xldown)
name sPath & cell as sPath & cell.Offset(0,1)
Nextd


--
Regards,
Tom Ogilvy

"electrica7926 " wrote in
message ...
Does anyone have a macro that will rename excel files with text from a
cell within the file?


---
Message posted from http://www.ExcelForum.com/

I'm still unclear about what exactly you would like to do. How many
Excel files do you have to rename? Are all the Excel files located in
the same directory? Will all the Workbooks that need to be renamed use
the same reference cell (i.e. "A1") or will you have to search through
all cells to look for a particular string?



Rollin.


---
Message posted from http://www.ExcelForum.com/

All the excel files are in the same directory and they will all be
rename by the same cell in each file. I have a couple hundred files
that need to be renamed.


---
Message posted from http://www.ExcelForum.com/

Dim sPath as String, sNameOld as StringDim sName as StirngDim i as LongWith
Application.FileSearch .NewSearch .LookIn = "C:\My Documents"
..SearchSubFolders = True .FileName = ".xls" .FileType =
msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To
..FoundFiles.Count set wkbk = workbooks.open( .FoundFiles(i))
sPath = wkbk.Path if right(spath,1) < "\" then spath = spath &
"\" sNameOld = wkbk.FullName sName =
wkbk.Worksheets(1).Range("A1").Value wkbk.close SaveChanges:=False
name sNameOld as sPath & sName Next i Else MsgBox "There
were no files found." End IfEnd With-- Regards,Tom Ogilvy"electrica7926
" wrote in message
...
All the excel files are in the same directory and they will all be
rename by the same cell in each file. I have a couple hundred files
that need to be renamed.


---
Message posted from http://www.ExcelForum.com/

Well, that jumbled up, perhaps this will go:

Dim sPath as String, sNameOld as String
Dim sName as Stirng
Dim i as Long
With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents"
.SearchSubFolders = True
.FileName = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
set wkbk = workbooks.open( .FoundFiles(i))
sPath = wkbk.Path
if right(spath,1) < "\" then spath = spath & "\"
sNameOld = wkbk.FullName
sName = wkbk.Worksheets(1).Range("A1").Value
wkbk.close SaveChanges:=False
name sNameOld as sPath & sName
Next i
Else
MsgBox "There were no files found."
End If
End With

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Dim sPath as String, sNameOld as StringDim sName as StirngDim i as
LongWith
Application.FileSearch .NewSearch .LookIn = "C:\My Documents"
.SearchSubFolders = True .FileName = ".xls" .FileType =
msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To
.FoundFiles.Count set wkbk = workbooks.open( .FoundFiles(i))
sPath = wkbk.Path if right(spath,1) < "\" then spath = spath &
"\" sNameOld = wkbk.FullName sName =
wkbk.Worksheets(1).Range("A1").Value wkbk.close
SaveChanges:=False
name sNameOld as sPath & sName Next i Else MsgBox "There
were no files found." End IfEnd With-- Regards,Tom Ogilvy"electrica7926
" wrote in message
...
All the excel files are in the same directory and they will all be
rename by the same cell in each file. I have a couple hundred files
that need to be renamed.


---
Message posted from http://www.ExcelForum.com/

Public Sub ReSave()

Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File

Application.DisplayAlerts = False

Set fso = New Scripting.FileSystemObject

Set fsDir = fso.GetFolder("C:\Source Directory")

For Each fsFile In fsDir.Files

Workbooks.Open Filename:= _
fsFile

-'Use this line to save workbook with name equal to text in cell "A1"-

ActiveWorkbook.SaveAs "C:\Destination Directory\" & Range("A1").Value
".xls"

-'Use this line to save workbook with name equal to old name + text i
cell "A1"-

ActiveWorkbook.SaveAs "C:\Destination Directory\"
Left(ActiveWorkbook.Name, InStr(1, ActiveWorkbook.Name, ".xls") - 1)
" " & Range("A1").Value

Next

End Sub



One more thing, Make sure to set reference to Micrososft Scriptin
Runtime (To do this, press ALT + F11 to bring up VB Editor and the
click TOOLS -- REFERENCE. When the reference library comes up, mak
to there is a checkmark in the box next to Micrososft Scriptin
Runtime. Once you check this box make sure to re-save your projec
with the newly created reference

--
Message posted from http://www.ExcelForum.com

It used to be that rename meant
"C:\Source Directory" = "C:\Destination Directory\"

and the file ceased to exist under the old name.

Maybe not anymore, eh?

--
Regards,
Tom Ogilvy

"Rollin_Again " wrote in
message ...
Public Sub ReSave()

Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File

Application.DisplayAlerts = False

Set fso = New Scripting.FileSystemObject

Set fsDir = fso.GetFolder("C:\Source Directory")

For Each fsFile In fsDir.Files

Workbooks.Open Filename:= _
fsFile

-'Use this line to save workbook with name equal to text in cell "A1"-

ActiveWorkbook.SaveAs "C:\Destination Directory\" & Range("A1").Value &
".xls"

-'Use this line to save workbook with name equal to old name + text in
cell "A1"-

ActiveWorkbook.SaveAs "C:\Destination Directory\" &
Left(ActiveWorkbook.Name, InStr(1, ActiveWorkbook.Name, ".xls") - 1) &
" " & Range("A1").Value

Next

End Sub



One more thing, Make sure to set reference to Micrososft Scripting
Runtime (To do this, press ALT + F11 to bring up VB Editor and then
click TOOLS -- REFERENCE. When the reference library comes up, make
to there is a checkmark in the box next to Micrososft Scripting
Runtime. Once you check this box make sure to re-save your project
with the newly created reference)


---
Message posted from http://www.ExcelForum.com/