Renaming Files

[Gordon]

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

[NickHK]

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" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>