Thread: Extract spesific line from more then 2000 txt files!

Hi,

i' m struggling a bit with extracting a specific line of a txt files.
I need this info from more then 2000 files.
The files are all in one folder.

The files looks like this
44256_mtestermd_DOC.txt
44256_mtestermd_PST.txt
44256_mtestermd_DESK.txt

Example file:


Volume in drive C has no label.
Volume Serial Number is xxxxxxxx

Directory of C:\Documents and Settings\mkerckwe\Desktop\0017418200 FC Bam [COPY]\Correspondentie-JRO

24/10/2011 15:57 1.568.424.960 MailbestandenO.pst
21/11/2011 08:58 564.806.656 MailbestandenO2.pst
2 File(s) 2.133.231.616 bytes

Directory of C:\Documents and Settings\mkerckwe\Desktop\002239 FC bla

21/11/2011 15:30 34.554.880 2239_FCtest_laptop.pst
1 File(s) 34.554.880 bytes

Directory of C:\Documents and Settings\mtesx\My Documents

21/11/2011 14:23 42.681.344 FCtester.pst
24/10/2011 15:57 331.170.816 Mtesrm.pst
24/10/2011 15:57 442.909.696 Maitesr3.pst
3 File(s) 816.761.856 bytes

Total Files Listed:
6 File(s) 2.984.548.352 bytes
0 Dir(s) 19.682.029.568 bytes free
COMPLETE-----------------------------------------------------

End example file


I need the following info from each file and add it to a cell.
6 File(s)
2.984.548.352
if "COMPLETE------------------------------------" is found in the file

My sheet should look like this:

A B B C D E F
1 44256_mtestermd_DOC.txt 44256 mtestermd DOC 2.984.548.352 6 File(s) EOF found
2

I hope someone can help me with this.
Sorry for my bad English!

Thx in advance!

Grts,
DWloko32

Hello DWloko32,

Welcome to the Forum!

This macro will search the directory you specify for all text files matching the naming style you posted. Copy and paste this code into new module in yourworkbook's VBA project.

You will need to change the directory name in the macro to match what you are using. You may also need to change the worksheet name and the starting cell. Currently these are set to "Sheet1" and "A1".

' Thread:  http://www.excelforum.com/excel-programming/804794-extract-spesific-line-from-more-then-2000-txt-files.html
' Poster:  DWloko32
' Written: December 08, 2011
' Author:  Leith Ross

Sub ExtractData()

    Dim Filename As String
    Dim Filepath As String
    Dim FSO As Object
    Dim I As Long
    Dim N As Long
    Dim R As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Text As String
    Dim TxtFile As Object
    Dim Wks As Worksheet
    
    
        Filepath = "C:\Documents and Settings\DWloko32"
        
        Set Wks = Worksheets("Sheet1")
        
        Set Rng = Wks.Range("A1")
        
            Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
            Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
            
            Filepath = IIf(Right(Filepath, 1) <> "\", Filepath & "\", Filepath)
            
            Set FSO = CreateObject("Scripting.FileSystemObject")
            
                Filename = Dir(Filepath & "*_mtestermd_*.txt")
                
                Do While Filename <> ""
                   Filename = Filepath & Filename
                   Set TxtFile = FSO.OpenTextFile(Filename, 1, False)
                       Text = TxtFile.ReadAll
                       I = InStr(1, Text, "Total Files Listed:" & vbCrLf)
                       If I > 0 Then
                          N = InStr(I + 21, Text, vbCrLf)
                          Text = Mid(Text, I + 21, N - I - 21)
                          I = InStr(1, Text, "bytes")
                          Text = Left(Text, I - 1)
                          Rng.Offset(R, 0) = Text
                          R = R + 1
                       End If
                   TxtFile.Close
                   Filename = Dir()
                Loop
                
End Sub