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/

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

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/

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/

Thank you for all your help you guys. This is going to alleviate a lo
of pains at my work. Thanks again

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

I am trying to rename several non-excel files. . . I bring in all the file names in a given directory into Excel (column A) and want to rename the file using columns A - D. . . . I don't want to open the file and do a saveas. . . When I use the ".Execute() 0 " line, it never seems to find the file name. . . . Any suggestions? I hate using windows explorer to rename files . . . Thanks!

Nevermind! I added the ".MatchTextExactly = True" and ".FileType = msoFileTypeAllFiles" and it worked. I don't know why it didn't work before, but it works now. THANK YOU TomOgilvy -- you ROCK!

.FileType = msoFileTypeExcelWorkbooks

..MatchTextExactly doesn't do anything - it is an option if you are
specifying to find text within the file. (but it doesn't cause any problem
either).

says to get only excel files.

--
Regards,
Tom Ogilvy

"JoyB" wrote in message
...
Nevermind! I added the ".MatchTextExactly = True" and ".FileType =
msoFileTypeAllFiles" and it worked. I don't know why it didn't work before,
but it works now. THANK YOU TomOgilvy -- you ROCK!

Tom Ogilvy wrote:
*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?*


Yes you are right Tom, but I am just used to keeping the original file
entact because there is always some Yo-Yo at work who comes back an
always complains about the changes made no matter how small an
insignifcant they are. It's amazing that some people including wil
cause such a fuss over something as simple as renaming a file. I
storage space permits, I'll always keep the original named files for a
least a few weeks until everyone knows that they have been renamed an
then I delete them. If nobody else will be using the files I will jus
rename the originals.


Rolli

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