Reading a specific line from multiple text files within several folders

Question

I have a large number of text files within several folders and I need the 14th line from each text file, I was wondering if there was anyway to do that?

Currently I have the following script setup, where I input the folder directory into cell A19 within the first worksheet and this returns the file paths of all files within the directory. I then want to get the information from the 14th line of every text file, utilising the aforementioned file paths. This is my code so far:

Private Sub CommandButton1_Click()


'Call the recursive function
    ListAllFiles ThisWorkbook.Sheets(1).Range("A19").Value, ThisWorkbook.Sheets(2).Cells(1, 1)
    ReadTxtFiles
    MsgBox "Task Completed"


 End Sub

---

Private Sub ListAllFiles(root As String, targetCell As Range)
    Dim objFSO As Object, objFolder As Object, objSubfolder As Object, objFile As Object
    Dim i As Integer, Target_Path As String

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(root)
'loops through each file in the directory and prints their names and path

For Each objFile In objFolder.Files
    'print file name
    targetCell.Value = objFile.Name
    'print file path
    targetCell.Offset(, 1).Value = objFile.Path
    'print file type
    'targetCell.Offset(, 2).Value = objFile.Type
    'print file date created
    'targetCell.Offset(, 3).Value = objFile.DateCreated
    'print file date last accessed
    'targetCell.Offset(, 4).Value = objFile.DateLastAccessed
    'print file date last modified
    'targetCell.Offset(, 5).Value = objFile.DateLastModified
    Set targetCell = targetCell.Offset(1)
Next objFile

' Recursively call the function for subfolders
For Each objSubfolder In objFolder.SubFolders
    ListAllFiles objSubfolder.Path, targetCell
    Next objSubfolder
End Sub

---

Private Sub ReadTxtFiles()

    'Dim start As Date
'start = Now

Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Dim oFS As Object


'''''Assign the Workbook File Name along with its Path
'''''Change path of the Target File name

Dim v As Variant, filepath As String
For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants)
filepath = v.Value
Debug.Print filepath


Dim arr(100000) As String
Dim i As Long
i = 0

If oFSO.FileExists(filepath) Then
    On Error GoTo Err

    Set oFS = oFSO.OpenTextFile(filepath)
    Do While Not oFS.AtEndOfStream
        arr(i) = oFS.ReadLine
        i = i + 1
    Loop
    oFS.Close
Else
    MsgBox "The file path is invalid.", vbCritical, vbNullString
    Exit Sub
End If

---

This is where I get stuck. I would like to read each text file and get the 14th line of each and nothing more.

Answer 1

Does this help? To test, run the procedure TestGetLine after setting path and file name.

Private Sub TestGetLine()
    ' 12 Apr 2017

    Dim Pn As String                                ' Path
    Dim Fn As String                                ' File
    Dim Ffn As String

    Pn = "D:\My Documents\"
    Fn = "TextFile 14"
    Ffn = Pn & Fn & ".txt"
    If Len(Dir(Ffn)) Then
        Debug.Print TextLine(Ffn, 14)
    Else
        MsgBox Chr(34) & Fn & """ doesn't exist.", _
               vbInformation, "Invalid file name"
    End If
End Sub

Private Function TextLine(ByVal Ffn As String, _
                          LineNum As Integer) As String
    ' 12 Apr 2017

    Dim FileNum As Integer
    Dim Txt As String
    Dim Ln As Integer

    Close                           ' close any open text files
    FileNum = FreeFile
    Open Ffn For Input As #FileNum
    Do While Not EOF(1)             ' Loop until end of file.
        Line Input #1, Txt
        Ln = Ln + 1
        If Ln = LineNum Then Exit Do
    Loop
    If Ln < LineNum Then
        Txt = "File """ & Split(Ffn, "\")(UBound(Split(Ffn, "\"))) & _
               """ has only " & Ln & " lines. No line was copied"
    End If
    Close
    TextLine = Txt
End Function

You can feed path (Pn) and file name (Fn) in which ever loop you require. Let the code add the extension .txt. Specify which line number you want in the function call, like TextLine(Ffn, 14) which specifies line 14.

Answer 2

Your ReadTxtFiles subroutine seems to read the data in, and then doesn't do anything with it. Maybe it does something in the part of the code you didn't post.

However, it is relatively straight-forward to just read 14 lines, and then whatever was last read in is the record you want:

Private Sub ReadTxtFiles()

    'Dim start As Date
    'start = Now

    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Dim oFS As Object


    '''''Assign the Workbook File Name along with its Path
    '''''Change path of the Target File name

    Dim v As Variant, filepath As String
    For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants)
        filepath = v.Value
        Debug.Print filepath


        Dim rec As String
        Dim i As Long
        i = 0
        rec = ""

        If oFSO.FileExists(filepath) Then
            On Error GoTo Err

            Set oFS = oFSO.OpenTextFile(filepath)
            Do While Not oFS.AtEndOfStream
                rec = oFS.ReadLine
                i = i + 1
                If i = 14 Then Exit Do
            Loop
            oFS.Close
        Else
            MsgBox "The file path is invalid.", vbCritical, vbNullString
            Exit Sub
        End If

        'Check we read 14 records
        If i < 14 Then
            MsgBox "Not enough records"
            Exit Sub
        End If

        'do whatever you want with "rec"
        '...
        '...

Answer 3

It's been a long time since I've done VBA but to find the nth iteration of a thing, use MOD. This is explains how to use it and there are plenty of other examples you can find on line.