Need Macro to rename excel files

[electrica7926]

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

 

[Tom Ogilvy]

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

 

[Rollin_Again]

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.

 

[electrica7926]

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.

 

[Tom Ogilvy]

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

 

[Rollin_Again]

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

 

[Tom Ogilvy]

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

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

 

[Tom Ogilvy]

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?

 

[electrica7926]

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

 

[Guest]

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!

 

[Guest]

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]

.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

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!

 

[Rollin_Again]

*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