WOW

Thanks Bob....




On Sun, 2 Dec 2007 23:38:56 -0000, "Bob Phillips"
wrote:

Option Explicit

Sub GetData2()
Dim fn As String
Dim ln As String
Dim FirstLine As String
Dim Res As Range
Dim fs, f, fl, fc, s
Dim i As Long

Set Res = Range("A1") 'upper left corner of Result range

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder("C:\test\")
Set fc = f.Files

i = 0

With Res

For Each fl In fc

If UCase(Right(fl.Path, 4)) = ".TXT" Then

fn = fl.Path
FirstLine = ""
Open fn For Input As #1
Do While Not EOF(1)

Input #1, ln
If FirstLine = "" Then FirstLine = ln
Loop
Close #1

.Offset(i, 0).Value = Left(FirstLine, 8)
.Offset(i, 1).Value = Mid(FirstLine, 9, 6)
.Offset(i, 1).NumberFormat = "000000"
.Offset(i, 2).Value = Mid(ln, 9, 6)
.Offset(i, 2).NumberFormat = "000000"
.Offset(i, 3).FormulaR1C1 = "=RC[-1]-RC[-2]+1"
.Offset(i, 3).NumberFormat = "0"
.Offset(i, 4).Value = fl.datelastmodified
i = i + 1
End If
Next fl
.Offset(0, 4).EntireColumn.AutoFit
End With

End Sub