VBA to import 10 most recently created text file to Excel - excel

Question

I currently have VBA code that opens each text file in a given location and imports data into Excel. The problem is that I have 1000's of text file in the location and I do not want to import them all. I only want to import the 10 most recently created text files. How do I change my Do While loop to achive this?
Sub LoopThroughTextFiles()
' Defines variables
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim Text As String
Dim Textline As String
Dim LastCol As Long
Dim RowCount As Long
' Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("26").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
' Defines LastCol as the last column of data based on row 1
LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
' Sets the folder containing the text files
myPath = "C:\26" & "\"
' Target File Extension (must include wildcard "*")
myExtension = "*.dat"
' Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
' Loop through each text file in folder
Do While myFile <> ""
' Sets variable "RowCount" To 1
RowCount = 1
' Sets variable "Text" as blank
Text = ""
' Set variable equal to opened text file
Open myPath & myFile For Input As #1
' Do until the last line of the text file
Do Until EOF(1)
' Add each line of the text file to variable "Text"
Line Input #1, Textline
Text = Textline
' Update RowCount row of the current last column with the content of variable "Text"
Cells(RowCount, LastCol).Value = Text
' Increase RowCount by 1
RowCount = RowCount + 1
Loop
' Close the text file
Close #1
' Increase LastCol by 1 to account for the new data
LastCol = LastCol + 1
' Get next text file name
myFile = Dir
Loop

Answer 1

Please try this approach. There are two constants at the top of the code which you may need to adjust. TopCount represents the number of files you want the names of. In your question this is 10 but in the code you can enter any number. TmpTab is the name of a worksheet the code will create in the ActiveWorkbook. Please pay close attention to this word: The ActiveWorkbook is the workbook you last looked at before you ran the code. It need not be the workbook that contains the code. Anyway, the code will create a worksheet by the name prescribed by the constant `TmpTab', use it for sorting and then delete it. If this is a name of an existing worksheet it will be cleared, used and deleted.
Function TenLatest() As String()
Const TopCount As Long = 10 ' change to meet requirement
Const TmpTab As String = "Sorter"
Dim Fun() As String ' function return value
Dim SourceFolder As String
Dim Fn As String ' File name
Dim Arr() As Variant
Dim Ws As Worksheet
Dim Rng As Range
Dim i As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
SourceFolder = .SelectedItems(1)
End If
End With
If SourceFolder <> "" Then ' a folder was chosen
ReDim Arr(1 To 2, 1 To 10000) ' increase if necessary
Fn = Dir(SourceFolder & "\*.TXT") ' change the filter "TXT" if necessary
Do While Len(Fn) > 0
i = i + 1
Arr(1, i) = SourceFolder & "\" & Fn
Arr(2, i) = FileDateTime(Arr(1, i))
Fn = Dir
Loop
If i < 1 Then i = 1
ReDim Preserve Arr(1 To 2, 1 To i)
Application.ScreenUpdating = False
On Error Resume Next
Set Ws = Worksheets(TmpTab)
If Err Then
Set Ws = Worksheets.Add
Ws.Name = TmpTab
End If
With Ws
.Cells.ClearContents
Set Rng = .Cells(1, 1).Resize(UBound(Arr, 2), UBound(Arr, 1))
Rng.Value = Application.Transpose(Arr)
With .Sort.SortFields
.Clear
.Add Key:=Rng.Columns(2), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
End With
With .Sort
.SetRange Rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
With Rng.Columns(1)
i = Application.WorksheetFunction.Min(.Rows.Count, TopCount)
Arr = .Range(.Cells(1), .Cells(i)).Value
End With
ReDim Fun(1 To UBound(Arr))
For i = 1 To UBound(Fun)
Fun(i) = Arr(i, 1)
Next i
TenLatest = Fun
With Application
.DisplayAlerts = False
Ws.Delete
.ScreenUpdating = True
.DisplayAlerts = True
End With
End If
End Function
The above code returns an array of (10) file names which you can use in whichever way is suitable for you. To test the function please use the procedure below. It will call the function and write its result to the Immediate Window.
Private Sub TestTenLatest()
Dim Fun() As String
Dim i As Integer
Fun = TenLatest
For i = 1 To UBound(Fun)
Debug.Print i, Fun(i)
Next i
End Sub

Answer 2

The solution that worked for me in the end was as follow. Specifically the line "test = FileDateTime(myPath & myFile)" did the trick for me. I then wrote the result back into the top row of the column the data was being pulled into.
Sub LoopThroughTextFiles()
' Defines variables
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim Text As String
Dim Textline As String
Dim LastCol As Long
Dim RowCount As Long
Dim test As Date
Dim fso As Object
' Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
' Defines LastCol as the last column of data based on row 1
LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
' Sets the folder containing the text files
myPath = "\\YourLocation" & "\"
' Target File Extension (must include wildcard "*")
myExtension = "*.dat"
' Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
' Loop through each text file in folder
Do While myFile <> ""
' Sets variable "RowCount" To 1
RowCount = 1
' Sets variable "Text" as blank
Text = ""
' Set variable equal to opened text file
Open myPath & myFile For Input As #1
' Do until the last line of the text file
Do Until EOF(1)
' Add each line of the text file to variable "Text"
Line Input #1, Textline
Text = Textline
' Update RowCount row of the current last column with the content of variable "Text"
Cells(RowCount, LastCol).Value = Text
' Increase RowCount by 1
RowCount = RowCount + 1
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
test = FileDateTime(myPath & myFile)
Cells([1], LastCol).Value = test
' Close the text file
Close #1
' Increase LastCol by 1 to account for the new data
LastCol = LastCol + 1
' Get next text file name
myFile = Dir
Loop