Dear All,

The macro below opens a number of text file with *.mea extension, doe
some calculation (average and std deviation). What I would like to d
is save the file with *.xls extension after calculation is done. I'
sure it will be adding a 1 or more lines of code. Hope anyone ca
help.

Regards,

Bharesh Mandalia

Sub BatchProcessor()
With Application.FileSearch
.NewSearch
.LookIn = "d:\activeb\" '(insert proper file directory)
.SearchSubFolders = True
.FileName = "ms1*.mea"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For I = 1 To .FoundFiles.Count
Workbooks.Open FileName:=.FoundFiles(I)
With ActiveWorkbook
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1")
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1))
Selection.AutoFilter
Range("B1").Select
Selection.AutoFilter Field:=1, Criteria1:="Dist"
Range("B2:B65536").Select
Selection.NumberFormat = "0.0000"
Selection.NumberFormat = "0.000"
Selection.Copy
Range("D1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

Selection.AutoFilter Field:=1
Range("E1").Select

ActiveCell.FormulaR1C1 = "=AVERAGE(C[-1])"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=COUNT(C[-2])"
Range("F2").Select
End With
Next I
Else
MsgBox "There were no files found"
End If
End Wit

--
Message posted from http://www.ExcelForum.com

Add this line after End With, before Next I

ActiveWorkbook.SaveAs Filename:="D:\"& .FoundFiles(I) &".xls"

and adjust path to your liking
Mike F


"m4nd4li4 " wrote in message
...
Dear All,

The macro below opens a number of text file with *.mea extension, does
some calculation (average and std deviation). What I would like to do
is save the file with *.xls extension after calculation is done. I'm
sure it will be adding a 1 or more lines of code. Hope anyone can
help.

Regards,

Bharesh Mandalia

Sub BatchProcessor()
With Application.FileSearch
NewSearch
LookIn = "d:\activeb\" '(insert proper file directory)
SearchSubFolders = True
FileName = "ms1*.mea"
MatchTextExactly = True
FileType = msoFileTypeAllFiles
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For I = 1 To .FoundFiles.Count
Workbooks.Open FileName:=.FoundFiles(I)
With ActiveWorkbook
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1))
Selection.AutoFilter
Range("B1").Select
Selection.AutoFilter Field:=1, Criteria1:="Dist"
Range("B2:B65536").Select
Selection.NumberFormat = "0.0000"
Selection.NumberFormat = "0.000"
Selection.Copy
Range("D1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

Selection.AutoFilter Field:=1
Range("E1").Select

ActiveCell.FormulaR1C1 = "=AVERAGE(C[-1])"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=COUNT(C[-2])"
Range("F2").Select
End With
Next I
Else
MsgBox "There were no files found"
End If
End With


---
Message posted from http://www.ExcelForum.com/

Many thanks, Mike F.

Bhares

--
Message posted from http://www.ExcelForum.com

Hi Mike,

Unfortunately I get an Runtime Error 1004. File could not be accessed
Please try, etc, etc.... The error occurs here....

ActiveWorkbook.SaveAs FileName:="D:\inactiveb\" & .FoundFiles(I)
".xls"

I have tried different paths to save the file to, but always the sam
error. Any suggestions????

Regards,

Bhares

--
Message posted from http://www.ExcelForum.com

..foundfiles(i) will have the path and extension in it.

So if you're saving to a different folder, you'll have to get rid of that path
as well as the extension.

But it looks like you want to save to the same folder.

so maybe:

If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
'your code here...
myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If

If you want to strip out the path, too:

Option Explicit
Sub BatchProcessor()
Dim myFileName As String
Dim myPath As String
Dim i As Long

With Application.FileSearch
.NewSearch
.LookIn = "C:\my documents\excel\"
.SearchSubFolders = True
.Filename = "ms1*.mea"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
myPath = ActiveWorkbook.Path & "\"

myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
myFileName = Mid(myFileName, Len(myPath) + 1)
myFileName = "c:\mynewpath\" & myFileName
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If
End With

End Sub

Watch out, I changed the path for my testing!

"m4nd4li4 <" wrote:

Hi Mike,

Unfortunately I get an Runtime Error 1004. File could not be accessed.
Please try, etc, etc.... The error occurs here....

ActiveWorkbook.SaveAs FileName:="D:\inactiveb\" & .FoundFiles(I) &
".xls"

I have tried different paths to save the file to, but always the same
error. Any suggestions????

Regards,

Bharesh

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Hi dave,

Many thanks for suggestion. It works great but the size of the file is
about 2MB! How come??? Shouldn't it be a lot smaller than 2MB???

Regards,

Bharesh

Dave Peterson wrote in message ...
.foundfiles(i) will have the path and extension in it.

So if you're saving to a different folder, you'll have to get rid of that path
as well as the extension.

But it looks like you want to save to the same folder.

so maybe:

If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
'your code here...
myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If

If you want to strip out the path, too:

Option Explicit
Sub BatchProcessor()
Dim myFileName As String
Dim myPath As String
Dim i As Long

With Application.FileSearch
.NewSearch
.LookIn = "C:\my documents\excel\"
.SearchSubFolders = True
.Filename = "ms1*.mea"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
myPath = ActiveWorkbook.Path & "\"

myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
myFileName = Mid(myFileName, Len(myPath) + 1)
myFileName = "c:\mynewpath\" & myFileName
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If
End With

End Sub

Watch out, I changed the path for my testing!

"m4nd4li4 <" wrote:

Hi Mike,

Unfortunately I get an Runtime Error 1004. File could not be accessed.
Please try, etc, etc.... The error occurs here....

ActiveWorkbook.SaveAs FileName:="D:\inactiveb\" & .FoundFiles(I) &
".xls"

I have tried different paths to save the file to, but always the same
error. Any suggestions????

Regards,

Bharesh

---
Message posted from http://www.ExcelForum.com/

Hi dave,

Many thanks for suggestion. It works great but the size of the file is
about 2MB! How come??? Shouldn't it be a lot smaller than 2MB???

Regards,

Bharesh

Dave Peterson wrote in message ...
.foundfiles(i) will have the path and extension in it.

So if you're saving to a different folder, you'll have to get rid of that path
as well as the extension.

But it looks like you want to save to the same folder.

so maybe:

If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
'your code here...
myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If

If you want to strip out the path, too:

Option Explicit
Sub BatchProcessor()
Dim myFileName As String
Dim myPath As String
Dim i As Long

With Application.FileSearch
.NewSearch
.LookIn = "C:\my documents\excel\"
.SearchSubFolders = True
.Filename = "ms1*.mea"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & "file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
myPath = ActiveWorkbook.Path & "\"

myFileName = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4) & ".xls"
myFileName = Mid(myFileName, Len(myPath) + 1)
myFileName = "c:\mynewpath\" & myFileName
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Next i
End If
End With

End Sub

Watch out, I changed the path for my testing!

"m4nd4li4 <" wrote:

Hi Mike,

Unfortunately I get an Runtime Error 1004. File could not be accessed.
Please try, etc, etc.... The error occurs here....

ActiveWorkbook.SaveAs FileName:="D:\inactiveb\" & .FoundFiles(I) &
".xls"

I have tried different paths to save the file to, but always the same
error. Any suggestions????

Regards,

Bharesh

---
Message posted from http://www.ExcelForum.com/