Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files
Hi
I have a collection of randomly titled excel files in a folder called Raw1. The only thing these files have in common is that on a sheet called summary, in cell D3, there is a random text string containing a random number. The code below is my unsuccessful stab at cycling through these files, identifying the random number within the random text string on D3, then saving the file with the identified number to the target destination file. Look at the following code. It creates the destination folder and says the task has been completed (done), but no files are converted and placed in the destination folder. I'm at my wits end! I run Excel 2003 on XP pro. Thanks... Sub FileNamer() Dim FilePath As String Dim FileName As String Dim aStart As Integer Dim DestPath As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES FilePath$ = "C:\Documents and Settings\cartwrig\Desktop\Raw1\" 'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM Source Dir) DestPath$ = "C:\tested\" If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$) FileName$ = Dir(FilePath$ & "*.xls") Do Until FileName$ = "" Workbooks.Open FilePath$ & FileName$, 0, 1 a$ = Workbooks(FileName$).Sheets("Summary").Range("D3") .Value For x = 1 To Len(a$) If IsNumeric(Mid(a$, x, 1)) = True Then aStart = x a$ = Right(a$, Len(a$) - aStart + 1) a$ = Trim(Left(a$, InStr(a$, " "))) GoTo NumFound End If Next NumFound: ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls" ActiveWorkbook.Close 0 FileName$ = Dir Loop Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "done" End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming Files
Gordon,
May help: Dim WB as Workbook Set WB=Workbooks.Open FilePath$ & FileName$, 0, 1 a$ = WB.Sheets("Summary").Range("D3").Value .... WB.SaveAs DestPath$ & a$ & ".xls" Also, you do not need the "GoTo NumFound"; use Exit For instead. Add a Debug.Print DestPath$ & a$ & ".xls", just before the .saveAs to see exact where you think you will save. NickHK P.S. It's normally a good idea to always use "Option Explicit" in all modules. "Gordon" wrote in message ... Hi I have a collection of randomly titled excel files in a folder called Raw1. The only thing these files have in common is that on a sheet called summary, in cell D3, there is a random text string containing a random number. The code below is my unsuccessful stab at cycling through these files, identifying the random number within the random text string on D3, then saving the file with the identified number to the target destination file. Look at the following code. It creates the destination folder and says the task has been completed (done), but no files are converted and placed in the destination folder. I'm at my wits end! I run Excel 2003 on XP pro. Thanks... Sub FileNamer() Dim FilePath As String Dim FileName As String Dim aStart As Integer Dim DestPath As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES FilePath$ = "C:\Documents and Settings\cartwrig\Desktop\Raw1\" 'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM Source Dir) DestPath$ = "C:\tested\" If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$) FileName$ = Dir(FilePath$ & "*.xls") Do Until FileName$ = "" Workbooks.Open FilePath$ & FileName$, 0, 1 a$ = Workbooks(FileName$).Sheets("Summary").Range("D3") .Value For x = 1 To Len(a$) If IsNumeric(Mid(a$, x, 1)) = True Then aStart = x a$ = Right(a$, Len(a$) - aStart + 1) a$ = Trim(Left(a$, InStr(a$, " "))) GoTo NumFound End If Next NumFound: ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls" ActiveWorkbook.Close 0 FileName$ = Dir Loop Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "done" End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Renaming Files | Excel Programming | |||
Renaming files | Excel Programming | |||
Renaming Files | Excel Discussion (Misc queries) | |||
Renaming Files: Take 2 | Excel Programming | |||
Renaming files | Excel Programming |