File Properties
 

I have a macro below that extracts information from a text file. How
can I also get the date and time of the date modified properties of
the files as well. And put that information in column E.

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




Range("A1").Select



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

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

i = 0

For Each fl In fc
If 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

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






Range("A1").Select


End Sub



Thanks

File Properties
 

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



--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"Little Penny" wrote in message
...
I have a macro below that extracts information from a text file. How
can I also get the date and time of the date modified properties of
the files as well. And put that information in column E.

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




Range("A1").Select



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

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

i = 0

For Each fl In fc
If 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

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






Range("A1").Select


End Sub



Thanks

File Properties
 

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