G
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
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