Extracting text from text files in folder & sub-folders

[JARichard74]

I am trying to loop through sub-folders, find .txt files, and extract the first line of each file. The following code seems to extract the first 4 lines of the first txt file found. Thanks for any assist.

Option Explicit

Sub ExtractProponents()
Dim CompanyName As String
Dim i As Integer, fileNumber As Long
Dim xFSO As Object, xFolder As Object, xFile As Object, xSFolder As Object
Dim MyPath As String
Dim objShell As Object, objFolder As Object

Application.ScreenUpdating = False
Application.AutoCorrect.AutoFillFormulasInLists = False

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "", 0, 0)
If Not objFolder Is Nothing Then
    MyPath = objFolder.self.Path & "\"
Else
    Exit Sub
    MyPath = "Desktop"
End If

    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(MyPath)
    For Each xSFolder In xFolder.subfolders
        For Each xFile In xSFolder.Files
            If xFSO.GetExtensionName(xFile.Path) = "txt" Then
            fileNumber = FreeFile
            Open xFile For Input As #fileNumber
            Line Input #1, CompanyName
            i = i + 1
            Cells(i, "A").Value = CompanyName
            End If
        Next
    Next
    Set xFSO = Nothing
    Set xFolder = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Sub

 

[EXCEL MAX]

Hello JARichard74,
If you still not saw the error I can notice that you not close file after opening.
Your first file stays opened and code reading only first file.
To resolve that, you can add "Close" line and make code look like this.

                Open xFile For Input As #fileNumber
                Line Input #1, CompanyName
                i = i + 1
                Cells(i, "A").Value = CompanyName
                Close
            End If
        Next

 

[JARichard74]

Thank you EXCEL MAX, as a newb to VBA, it would have taken me a while to figure it out. Marked as solution

Hello JARichard74,
If you still not saw the error I can notice that you not close file after opening.
Your first file stays opened and code reading only first file.
To resolve that, you can add "Close" line and make code look like this.

                Open xFile For Input As #fileNumber
                Line Input #1, CompanyName
                i = i + 1
                Cells(i, "A").Value = CompanyName
                Close
            End If
        Next

 

[EXCEL MAX]

Sometimes when you are tired take a pause and make a breath,
otherwise your mind will be confused.
Thanks to you too.