Return First Line from a group of files

W

willwonka

I have a folder with about 150 text files. I would like a macro that
would return the first line of each of those files into a spreadsheet.

The files do share a comman name with a sequence number at the end.
For example, the first filename would be:

210SHyyyy.mm.ddx.txt

where x starts at 0 and goes to 150

Is this possible?
 
C

Chip Pearson

You can use the following code to open each file and put the first
line of the text file on a worksheet, one row per file. Change the
FolderName value to the appropriate folder name, and change the
Destination value to the worksheet name and cell address where the
first text will be written.

Sub AAA()
Dim FolderName As String
Dim Destination As Range
Dim FName As String
Dim FNum As Integer
Dim S As String

'<<< CHANGE FOLDER NAME
FolderName = "C:\Test"
'<<< CHANGE DESTINATION
Set Destination = Worksheets("Sheet1").Range("A1")

ChDrive FolderName
ChDir FolderName
FName = Dir("*.txt")
Do Until FName = vbNullString
FNum = FreeFile()
Open FName For Input Access Read As #FNum
Line Input #FNum, S
Close #FNum
Destination.Value = S
Set Destination = Destination(2, 1) ' move down
FName = Dir()
Loop
End Sub

Cordially,
Chip Pearson
Microsoft MVP
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 
J

Joel

The code is looking at all *.txt files in ther directory FOLDER. Change
Folder as required.


Sub GetFirstLine()

Folder = "C:\temp\"


Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fsread = CreateObject("Scripting.FileSystemObject")


FName = Dir(Folder & "*.txt")
RowCount = 1
Do While FName <> ""
Set fread = fsread.GetFile(Folder & FName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

InputLine = tsread.ReadLine
Range("A" & RowCount) = FName
Range("B" & RowCount) = InputLine

tsread.Close
FName = Dir()

RowCount = RowCount + 1
Loop
End Sub
 
W

willwonka

Thanks... worked like a charm.


The code is looking at all *.txt files in ther directory FOLDER.  Change
Folder as required.

Sub GetFirstLine()

Folder = "C:\temp\"

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fsread = CreateObject("Scripting.FileSystemObject")

FName = Dir(Folder & "*.txt")
RowCount = 1
Do While FName <> ""
   Set fread = fsread.GetFile(Folder & FName)
   Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

   InputLine = tsread.ReadLine
   Range("A" & RowCount) = FName
   Range("B" & RowCount) = InputLine

   tsread.Close
   FName = Dir()

   RowCount = RowCount + 1
Loop
End Sub







- Show quotedtext-
 
Top