E
electrica7926
Does anyone have a macro that will rename excel files with text from
cell within the file
cell within the file
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
T
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
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
R
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.
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.
E
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.
rename by the same cell in each file. I have a couple hundred files
that need to be renamed.
T
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
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
R
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
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
T
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 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 said: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
T
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?
"C:\Source Directory" = "C:\Destination Directory\"
and the file ceased to exist under the old name.
Maybe not anymore, eh?
E
electrica7926
Thank you for all your help you guys. This is going to alleviate a lo
of pains at my work. Thanks again
of pains at my work. Thanks again
G
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!
G
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!
T
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
but it works now. THANK YOU TomOgilvy -- you ROCK!
..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
msoFileTypeAllFiles" and it worked. I don't know why it didn't work before,JoyB said:Nevermind! I added the ".MatchTextExactly = True" and ".FileType =
but it works now. THANK YOU TomOgilvy -- you ROCK!
R
Rollin_Again
Tom said:*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