JARichard74
Board Regular
- Joined
- Dec 16, 2019
- Messages
- 114
- Office Version
- 365
- Platform
- Windows
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.
VBA Code:
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