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

MoeAk

New Member
Joined
Jun 4, 2019
Messages
1
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!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,239
Office Version
  1. 2007
Platform
  1. Windows
Try this

Code:
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
 

Forum statistics

Threads
1,136,300
Messages
5,674,961
Members
419,536
Latest member
Mohammed Jaffer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top