How do I open multiple *.txt files and save as .xls

[ronabo]

I have to create a macro that opens multiple pipe delimited .txt files and save each file into it's own .xls file. Please help. I have being trying to make this work for weeks. Here is the script that have being working on.

Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
' returns the full filename for files matching
' the filter criteria in the current folder
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.txt" ' all files
With Application.FileSearch
.NewSearch
.LookIn = "c:\test"
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
End Function

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:\My Documents"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.txt", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A&quot.ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)

Application.DisplayAlerts = False 'Turn off before saving
Open LookIn & Left(FileNamesList(i), InStr(1, FileNamesList(i), ".&quot - 1) & ".XLS" For Output As FreeFile
Application.DisplayAlerts = True 'Turn on so important messages display



MsgBox FileNamesList(i)

Next i
End Sub