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

[MoeAk]

Hi

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 would want to transfer 7 text files into them.


The text files have six columns, which are separated by commas, and I would want to extract two columns out of it and paste it under the wanted heading. So that each heading have two columns of data out of one text file.


I want to open the text files in order with the oldest date text file and paste them under the headings, so that the oldest saved text file is opened under heading number-1 and following that to the recent text file under heading-7.

All I have reached to is separating a singular text file and pasting it under one heading while selected a cell. 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
*********

What I need is open text files with oldest date at once and paste them under the headings in the spreadsheet with the two wanted columns in each text file.

Thanks in advance I appreciate it much!

 

[DanteAmor]

Try this

Sub OpenTxt()
    Dim fso As Object, carpeta As Object, ficheros As Object, archivo As Object
    Dim wPath As String, wFile As String, i  As Long, j As Long, k As Long
    Dim sh1 As Worksheet, sh2 As Worksheet, FilePath As String
    Dim LineFromFile As Variant, LineItems As Variant
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Temp")
    sh1.Rows("2:" & Rows.Count).ClearContents
    sh2.Rows("2:" & Rows.Count).ClearContents
    
    wPath = "c:\trabajo\files\"
    
    'Put the file names on the temp sheet
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set carpeta = fso.GetFolder(wPath)
    Set ficheros = carpeta.Files
    sh2.Range("A1").Value = "Name"
    sh2.Range("B1").Value = "Date"
    i = 2
    For Each archivo In ficheros
        If Right(archivo.Name, 3) = "txt" Then
            sh2.Cells(i, "A").Value = archivo.Name
            sh2.Cells(i, "B").Value = archivo.DateLastModified
            i = i + 1
        End If
    Next
    
    'Sort by the oldest
    sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Sort _
        key1:=sh2.Range("B1"), order1:=xlAscending


    'Read file by file
    k = 1
    For i = 2 To sh2.Range("A" & Rows.Count).End(xlUp).Row
        j = 2
        FilePath = wPath & sh2.Cells(i, "A").Value
        Open FilePath For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        Do Until EOF(1)
            Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , LineFromFile
            LineItems = Split(LineFromFile, ",")
            sh1.Cells(j, k).Value = LineItems(1)
            sh1.Cells(j, k + 1).Value = LineItems(4)
            j = j + 1
        Loop
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        k = k + 2
    Next
End Sub