Open Multiple Text Files with Selected Data in Specific Columns using VBA - excel

Question

May you please help me with this, I spent hours trying to figure it out but couldn't. Note: I am still learning VBA.
I have 7 headings in one spreadsheet that I want to transfer 7 text files into them.
In each text file, I want 2 columns in the text file to be selected and put into the correct heading.
I have got that bit done, but I want all text files to open at once at each heading. My problem is the files are changeable, so I don't want to specify the file name, just the path and it picks the oldest date text file to the first heading in the spreadsheet.
I tried Dir("Y:\Engineering\" & "*.txt") but Open command doesn't work, unless the path is correct and a copy of the text file is in the User Document Folder. Can I fix that to only being in the path without a need of a copy in a different folder?
Thanks in advance I appreciate it much!
This is what I have done:
Sub OpenText()
Dim FilePath As String
FilePath = "Y:\Engineering\1.txt"
Open FilePath For Input As #1
row_number = 0
Do Until EOF(1)
Line Input #1 , LineFromFile
LineItems = Split(LineFromFile, ",")
ActiveCell.Offset(row_number, 0).Value = LineItems(1)
ActiveCell.Offset(row_number, 1).Value = LineItems(4)
row_number = row_number + 1
Loop
Close #1
End Sub

Answer 1

Updated code.
Main() function does the actions, also you should setup this part:
sPath = "C:\Tets\"
Conditions: you should have following sheets in excel file - FileList, Import, ImportResults
You can try following code:
Option Explicit
Public oFSO As Object
Public arrFiles()
Public lngFiles As Long
Sub Main()
Dim sPath As String
Dim strXlsList As String
Dim strXlsListImport As String
Dim strXlsListImportResults As String
sPath = "C:\Tets\1\"
strXlsList = "FileList"
strXlsListImport = "Import"
strXlsListImportResults = "ImportResults"
Dim lngFilesCount As Long
lngFilesCount = 0
Erase arrFiles
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
Dim Counter As Long
For Counter = 0 To UBound(arrFiles, 2)
Sheets(strXlsList).Range("A" & Counter + 1) = arrFiles(0, Counter)
Sheets(strXlsList).Range("B" & Counter + 1) = arrFiles(1, Counter)
lngFilesCount = lngFilesCount + 1
Next Counter
' filter due date
If ActiveSheet.Name <> strXlsList _
Then
Sheets(strXlsList).Activate
End If
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("FileList").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FileList").Sort.SortFields.Add Key:=Range("B2:B4") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("FileList").Sort
.SetRange Range("A2:B4")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim lngCurrent As Long
Dim lngFilePositionColumn As Long
Dim lngOffset As Long
lngFilePositionColumn = 1
lngOffset = 1
For lngCurrent = 2 To lngFilesCount - 1
' import file
ImportTextFile Sheets(strXlsList).Range("A" & lngCurrent), strXlsListImport
' copy data from 2nd column
subCopyData strXlsListImport, strXlsListImportResults, 2, lngOffset
lngOffset = lngOffset + 1
' copy data from 5th column
subCopyData strXlsListImport, strXlsListImportResults, 5, lngOffset
lngOffset = lngOffset + 1
Next lngCurrent
End Sub
Public Sub subCopyData( _
ByVal strSheetFrom As String, _
ByVal strSheetTo As String, _
ByVal lngColumnNumberFrom As Long, _
ByVal lngOffset As Long)
Sheets(strSheetFrom).Activate
Columns(lngColumnNumberFrom).Select
Selection.Copy
Sheets(strSheetTo).Select
Columns(lngOffset).Select
ActiveSheet.Paste
End Sub
Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)
'Collect file information
For Each oFile In oFolder.Files
lngFiles = lngFiles + 1
ReDim Preserve arrFiles(1, lngFiles + 1)
arrFiles(0, lngFiles) = sPath & oFile.Name
arrFiles(1, lngFiles) = oFile.DateLastModified
Debug.Print lngFiles
Next oFile
'looking for all subfolders
For Each oSubFolder In oFolder.SubFolders
'recursive call is commented, looks only in folder
'Call recurse(oSubFolder.Path)
Next oSubFolder
End Sub
Sub ImportTextFile( _
ByVal strFile As String, _
ByVal strXlsList As String _
)
If ActiveSheet.Name <> strXlsList _
Then
Sheets(strXlsList).Activate
End If
' clear existing data
Cells.Select
Selection.Delete Shift:=xlUp
' import text file
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFile, _
Destination:=Range("$A$1"))
'.CommandType = 0
.Name = "next"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 866
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub