Thread: Renaming Files
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Gordon[_2_] Gordon[_2_] is offline
external usenet poster
 
Posts: 211
Default 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