Copying extracted .txt file data on a spreadhseet to fill into another workbook

[bigbeat85]

Hi All,

I am trying to fix and modify a tool which will automatically populate two seperate spreadsheets with the extracted data.

The File Extractor macro is told to look as specific .txt files and extract the data. The quantity can vary on what it is extracting.

Once the data extracts it opens a Workbook and names a sheet 'Extract Report' and autopopulates the sheet in rows for each result.

I am trying to add on, it will then select the data from the 'Extract Report' and paste into a two seperate sheets whilst changing the layout of the information to conform to the formatting of the new spreadsheets.

I am potentially aware that I can change the 'Extract Report' output file to the one I need. The difficulty I am having is trying to understand it.

Code for the file extraction

Option Explicit
Dim File As Object
Dim ReadFiles As Collection
Dim Line As Variant
Dim LineStr As Collection
Dim WBK As Workbook
Dim WSht As Worksheet

Sub MainCobraFileExtractor()
Application.ScreenUpdating = False
    Set ReadFiles = New Collection
    Set LineStr = New Collection
    CoreListFilesInFolder
        
    If ReadFiles.Count = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If

    For Each File In ReadFiles
        Call ReadFile(File)
    Next
    
    If LineStr.Count = 0 Then
        MsgBox "No records found in the files"
        Exit Sub
    End If
    
    SetupOutputFile
    
    For Each Line In LineStr
        WriteLine (Line)
    Next
    MsgBox "Finished"
Application.ScreenUpdating = True
End Sub


Function CoreListFilesInFolder()
Dim YesNo
Dim FolderName As String
Dim SubFolders As Boolean

FolderName = SelectFolder("Please enter the folder and path that you wish to break down")
    
If FolderName = "" Then Exit Function
YesNo = MsgBox("Include Subfolders?", vbYesNo + vbQuestion, "Subfolders?")
Select Case YesNo
Case vbYes
SubFolders = True
Case vbNo
SubFolders = False
Case Else
Exit Function
End Select
'MsgBox "Working on Folder " & FolderName & ". Subfolders included = " & SubFolders
    
    Call ListFilesInFolder(FolderName, SubFolders)
    ' list all files included subfolders

End Function

Function ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As scripting.FileSystemObject
Dim SourceFolder As scripting.Folder, SubFolder As scripting.Folder
Dim FileItem As scripting.File
Dim r As Long

On Error Resume Next
    Set FSO = New scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    For Each FileItem In SourceFolder.Files
        If WorksheetFunction.Right(FileItem.Name) = ".txt" Then
            ReadFiles.Add FileItem
        End If
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Function

Function ReadFile(Filex As scripting.File)
Dim LineOfText As String
Dim File_Path As String
'Set Variables to Capture Lines of File
File_Path = Filex.Path
'Open File Name to Read lines
    Open File_Path For Input Access Read As #1
'Read File into Lines Variable
    Do While Not EOF(1)
        Line Input #1, LineOfText
        If LineOfText <> "" Then
            LineStr.Add LineOfText & "," & Filex.Name & "," & Filex.Path
        End If
    Loop
'Close File
    Close #1
End Function

Function SetupOutputFile()

    Set WBK = Workbooks.Add
    Set WSht = WBK.Sheets(1)
    WSht.Name = "Extract Report"
    
    WSht.Cells(1, 1).Value = "Module Ident"
    WSht.Cells(1, 2).Value = "Date"
    WSht.Cells(1, 3).Value = "Time Slot Finished"
    WSht.Cells(1, 4).Value = "Tester"
    WSht.Cells(1, 5).Value = "Test Result"
    WSht.Cells(1, 6).Value = "Test Type"
    WSht.Cells(1, 7).Value = "Module Position"
    WSht.Cells(1, 8).Value = "Unknown2"
    WSht.Cells(1, 9).Value = "Test Station"
    WSht.Cells(1, 10).Value = "Unknown4"
    WSht.Cells(1, 11).Value = "Accept Time"
    WSht.Cells(1, 12).Value = "File Name"
    WSht.Cells(1, 13).Value = "File Path"