ExcelBanter - Extracting Text Data to Excel

I'm assuming that the 46 text files are all in the same folder (in my
example, C:\Test), that they all have a file extension of "txt" and that no
other files in that folder have a txt extension. In the TextToColumns
routine, you will need to provide more Array information to get a decent
result.

Sub FetchSomeLines()

Dim R As Integer
Dim rngA As Range
Dim rngB As Range

Const ForReading = 1

strFldPath = "C:\Test"
R = 1

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFldr = FSO.GetFolder(strFldPath)

For Each objFile In objFldr.Files
If FSO.GetExtensionName(objFile) = "txt" Then
Set objTextFile = FSO.OpenTextFile(objFile, ForReading)
objTextFile.ReadLine
objTextFile.ReadLine
Cells(R, 1).Value = objTextFile.ReadLine
R = R + 1

For I = 1 To 42
objTextFile.ReadLine
Next I

Cells(R, 1).Value = objTextFile.ReadLine
R = R + 2

objTextFile.Close

End If
Next objFile

Set rngA = Range("A1").EntireColumn
Set rngB = Range("B1")

rngA.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

rngA.Delete

End Sub

Steve

"Ozzie via OfficeKB.com" <u18021@uwe wrote in message
news:5b4669a0bbeff@uwe...
I have been struggling now for a few days, so time to ask the experts. My
problem is this;

I have 46 txt files each in exactly the same format and layout each with
different file names,
I need to be able to open all the files in th efolder Without specifying
file
names,
Then to be able to extract the 3rd and 46th line from each txt file,
I then want to paste these 2 lines into a workbook leave a space and then
paste the next 2 lines and so on,
and finally the two lines will need formatted to "text to columns\fixed
width\

can anyone help?

many thanks

David

--
Message posted via http://www.officekb.com