Dear members of Stackoverflow,
My script is still lacking some functionality. It requires two extra functions: - Skip the first 7 characters, put the remainder of the line into a cell. - After completing a txt move 1 colomn left and go back to row 1
My script is the following:
Sub ReadFilesIntoActiveSheet() Dim fso As FileSystemObject Dim folder As folder Dim file As file Dim FileText As TextStream Dim TextLine As String Dim Items() As String Dim i As Long Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("F:\Google Drive\IBE project - Heamoscan\Data")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
i = 0
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
Set cl = cl.Offset(0, 1)
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Any suggestions are very welcome! Many thanks
