Hi all -
I have several thousand text files I have put in a single folder I need to compile in a single workbook, which I am able to do easily using the below code.
I am also easily able to extract the FileNames of all the files in that folder with the code below that.
What I maddeningly can't seem to do is do both - combine the code below such that it will take extract the data in one file line-by-line and then in a NEW column at the end of each row, paste the file name.
Essentially, I want all of the files in the folder compiled in a new workbook, but I want an additional column so I can sort/identify the data by the original .txt file from which it came.
Unfortunately, in these original files, there is no unique identifier INSIDE the data file - the only unique identifier is in the FileName.
Any help or strategies would be greatly appreciated.
Extracting Files:
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("W:\WorkStuff_Rpts\WorkStuff_Folder" )
' 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
Set FileText = file.OpenAsTextStream(ForReading)
' 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
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Extracting File Names:
Sub GetFileNames()
Dim xRow AsLong
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$="G:\"'<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath &"\"
.Title ="Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If.SelectedItems.Count <>0Then
xDirect$=.SelectedItems(1)&"\"
xFname$= Dir(xDirect$,7)
DoWhile xFname$<>""
ActiveCell.Offset(xRow)= xFname$
xRow = xRow +1
xFname$= Dir
Loop
EndIf
EndWith
EndSub