VBA to import 10 most recently created text file to 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