Save .txt file as .xls format - HOW??

  • Thread starter Thread starter m4nd4li4
  • Start date Start date
M

m4nd4li4

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
 
Add this line after End With, before Next I

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

and adjust path to your liking
Mike F
 
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
 
..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!
 
Hi Dave,

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

Regards,

Bharesh

:confused
 
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
 
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top