Input data into a worksheet from files in order of date modified

[MrMagoo1]

Right now I have a macro that retrieves data from .chr files that are in the same folder as the excel workbook. It goes through the files and puts them in a worksheet in order by file name. I would like to put the data in the order of data modified

---

Dim myName, myPath, myName1, qt1
Dim counter, counter1 As Integer
Dim OK As Integer
Dim I As Integer

myPath = ThisWorkbook.Path & "\"
myName = Dir(myPath & "*.txt")
Worksheets(1).Activate
Worksheets.Add
Worksheets(1).Name = "merge__chr"
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
counter = 1
counter1 = 1
OK = 0
OK = InStr(1, myName, "chr.txt", vbTextCompare)
Do While myName <> ""

Do While OK = 0 And myName <> ""
myName = Dir
OK = InStr(1, myName, "chr.txt", vbTextCompare)
Loop

myName1 = "TEXT;" & myPath & myName
If OK <> 0 Then
With Worksheets("merge__chr").QueryTables.Add(Connection:=myName1, Destination:=Worksheets("merge__chr").Cells(counter1, 1))
If counter1 > 1 Then
.TextFileStartRow = 2
End If
.Refresh
End With
For I = 1 To 2
If Worksheets("merge__chr").Cells(counter1, 1) = "" Then
Set currentCell = Worksheets("merge__chr").Cells(counter1, 1)
currentCell.EntireRow.Delete
End If
counter1 = counter1 + 1
Next
counter1 = 1
Do While Worksheets("merge__chr").Cells(counter1, 1) <> ""
counter1 = counter1 + 1
Loop
End If
OK = 0

Loop
Do While Worksheets("merge__chr").Cells(counter, 1) <> ""
If Worksheets("merge__chr").Cells(counter, 1) = "END" Then
Set currentCell = Worksheets("merge__chr").Cells(counter, 1)
currentCell.EntireRow.Delete
End If
counter = counter + 1
Loop

 

[John_w]

Change the Dir function loop to put the file names and modified dates (using the FileDateTime function) in sheet columns and do a VBA Sort on the result (record a sort macro to generate the code). Or put the file names and dates in an array and sort that. Then import the data by looping through the sorted file names.

 

[MrMagoo1]

would you be able to show me a little what that would look like?

 

[MrMagoo1]

Here is some code I have tried, the myPath function is not found;

Sub lastmodifieddate()

Dim myName, myPath, myName1, qt1
    Set fso = CreateObject("Scripting.FileSystemObject")


Set List = CreateObject("ADOR.Recordset")
List.Fields.Append "name", 200, 255
List.Fields.Append "date", 7
List.Open


myPath = ActiveWorkbook.Path
For Each f In fso.GetFolder("myPath").Files
  List.AddNew
  List("name").Value = f.Path
  List("date").Value = f.DateLastModified
  List.Update
Next


List.MoveFirst
Do Until List.EOF
  ActiveCell = List("date").Value & vbTab & List("name").Value
  ActiveCell.Offset(1, 0).Select
  List.MoveNext
Loop


List.Sort = "date DESC"


List.MoveFirst
Do Until List.EOF
  ActiveCell = List("date").Value & vbTab & List("name").Value
  ActiveCell.Offset(1, 0).Select
  List.MoveNext
Loop


List.Close
End Sub

 

[John_w]

To fix the specific error, you want contents of the myPath variable, not the literal path "myPath", so remove the quotes:

For Each f In fso.GetFolder(myPath).Files

I've never used ADOR.Recordset, and haven't tested the code you posted, however it seems overkill for what you need.

This method uses a Dir function loop and VBA Sort as suggested. The For Next code loops through the matching files in order of date modified, newest first.

Public Sub Files_Sort()

    Dim matchFiles As String, fileName As Variant, folder As String
    Dim fileNamesSheet As Worksheet
    Dim r As Long
    
    matchFiles = "C:\folder\path\*.chr"    'Change folder path and wildcard file spec to be matched
    
    Set fileNamesSheet = Worksheets("Sheet1")
    fileNamesSheet.Cells.Clear
    
    folder = Left(matchFiles, InStrRev(matchFiles, "\"))
    fileName = Dir(matchFiles)
    r = 0
    While fileName <> ""
        r = r + 1
        fileNamesSheet.Cells(r, 1).Value = fileName
        fileNamesSheet.Cells(r, 2).Value = FileDateTime(folder & fileName)
        fileName = Dir
    Wend
    
    fileNamesSheet.UsedRange.Sort Key1:=fileNamesSheet.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    For Each fileName In Application.Index(fileNamesSheet.UsedRange, , 1)
        Debug.Print folder & fileName
        'Insert your data retrieval code here
    Next
    
End Sub