Open the fiels in folder based on last modified date

yogeshtalks · Oct 13th 2011

Dear all,

Thanks for your help all this while. It was very useful all the way.

I am using the following code:

Code

Set SourceFolder = FSO.GetFolder("C:\Path\")
            
  For Each FileItem In SourceFolder.Files
      Application.Workbooks.Open (FileItem)
'Further operations to be performed bu extracting some data from teh opened files one by one

I want to modify the above code such that the file is opened based on the last modified date property(I mean the oldest file to be opened first and sequentially the files are opened with the latest file opened as the last file)

I want to extract some data from opened files and update another list based on date in ascending order.

Please note that the date is updated in columns so that i cannot sort by date after the whole list is created. also, the file that i am updating is a template so I cannot edit it according to my own needs.

Apologize me for such an ambiguous query. Plese let me know if you do not understand what I exactly mean.

thanks

Cheers
Yogesh

jindon · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

Here's to start with

Code

Sub OpenByLastModifiedDate()
    Dim myDir As String, temp(), myList, myExtension As String
    Dim SearchSubFolders As Boolean, myFileName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            myDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    myFileName = "*.xls*"
    ReDim temp(1 To 3, 1 To 200)
    myList = SearchFiles(myDir, myFileName, 0, temp())
    If Not IsError(myList) Then
        HSortM myList, 1, UBound(myList, 2), 3
        DoTheJob myList
    Else
        MsgBox "No file found"
    End If
End Sub


Private Sub DoTheJob(a)
Dim i As Long
For i = 1 To UBound(a, 2)
    With Workbooks.Open(a(1, i) & "\" & a(2, i))
        ' Your code here
        .Close False
    End With
Next
End Sub


Private Function SearchFiles(myDir As String _
    , myFileName As String, n As Long, myList()) As Variant
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.getfolder(myDir).Files
        If (Not myFile.Name Like "~$*") _
        * (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
        * (UCase(myFile.Name) Like UCase(myFileName)) Then
            n = n + 1
            If n > UBound(myList, 2) Then
                ReDim Preserve myList(1 To 2, 1 To n)
            End If
            myList(1, n) = myDir
            myList(2, n) = myFile.Name
            myList(3, n) = myFile.datelastmodified
        End If
    Next
    If n > 0 Then ReDim Preserve myList(1 To 3, 1 To n)
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function




Private Sub HSortM(ary, LB, UB, ref)
Dim M, temp, i As Long, ii As Long, iii As Long
i = UB: ii = LB
M = ary(ref, Int((LB + UB) / 2))
Do While ii <= i
    Do While ary(ref, ii) < M
        ii = ii + 1
    Loop
    Do While ary(ref, i) > M
        i = i - 1
    Loop
    If ii <= i Then
        For iii = LBound(ary, 1) To UBound(ary, 1)
            temp = ary(iii, ii): ary(iii, ii) = ary(iii, i)
            ary(iii, i) = temp
        Next
        ii = ii + 1: i = i - 1
     End If
Loop
If LB < i Then HSortM ary, LB, i, ref
If ii < UB Then HSortM ary, ii, UB, ref
End Sub

Display More

smuzoen · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

Sorting arrays is not fun so there is an easy way around this. You can write the names and datelastmodified to a worksheet and then sort the data by date then read the data from the worksheet back into an array. What you will be left with is 2 arrays - ordList(1) and ordList(2) - you can ignore ordList(2) (this is just a modified date value) - the array ordList(1,1) will be the oldest file, ordList(1,2) will be the second oldest and so on. Just change the path to your directory of interest and the file extension to the type of excel file. The code below will write the files to Sheet1 and then read the ordered list back into the array.
You will need to add a reference to this - In VBA editor select Tools, Add Reference and tick Microsoft Scripting Runtime otherwise you cannot use FileSystemObject.

Code

Sub fileList(sPath As String)
On Error GoTo errhandler
Dim ordList()
Dim dataArray As Range
Dim fso As New FileSystemObject
    Dim fls As Files
    Dim strText As String
    Dim i As Integer
    Set fls = fso.GetFolder(sPath).Files
    
    i = 1
            For Each f In fls
            If Right(f.Name, 3) = "xls" Then ' change this if want different excel file
            Cells(i, 1) = f.Name
            Cells(i, 2) = f.DateLastModified
            i = i + 1
            End If
        Next
  
  Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With




Set dataArray = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
ordList = Application.Transpose(dataArray)
Exit Sub
errhandler:
MsgBox "Error no = " & Err.no & " - " & Err.Description
End Sub








Sub getFiles()
fileList ("c:\excel") ' change to path where files are
End Sub

Display More

Hope this helps

jindon · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

Set the reference is not fun to me...

smuzoen · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

Sorry Jindon I wrote this not knowing you had posted. I mean no offense.

yogeshtalks · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

Thanks a lot guys...

But, i need some time to spend on it to understand whats going on.....

At this moment, whatever you have posted seems like Greek and Latin for me...

I will try them and get back later....

smuzoen · Oct 13th 2011

Re: Open the fiels in folder based on last modified date

For those that don't like adding references you could use this to do the same = write values to sheet and let excel do the sorting. Again ordList(1,1) is oldest files, ordList(1,2) second oldest. Just add this code to a module and change the directory you require or incorporate Jindons method of browsing to folder of interest. As I said there is no need to add any references.

Code

Sub fileList(sPath As String)
    On Error GoTo errhandler
    Dim ordList()
    Dim dataArray As Range
    Dim fso As Object, f As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim i As Integer
    i = 1
     For Each f In fso.getfolder(sPath).Files
        If Right(f.Name, 3) = "xls" Then ' change this if want different excel file
            Cells(i, 1) = f.Name
            Cells(i, 2) = f.DateLastModified
            i = i + 1
        End If
    Next
     
    Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     
     
    Set dataArray = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    ordList = Application.Transpose(dataArray)
    Exit Sub
errhandler:
    MsgBox "Error no = " & Err.no & " - " & Err.Description
End Sub
 
  
Sub getFiles()
    fileList ("c:\excel") ' change to path where files are
End Sub

Display More

yogeshtalks · Oct 15th 2011

Re: Open the fiels in folder based on last modified date

Thanks a lot fellas.

It as too hard for me to play with arrays and stuff. Therefore, i found my own way with your advice. I made a copy of the file names and their modified date in to a sheet and sorted them according to the date and then while opening the files, i referenced the file names in the order that i sorted. It works great exactly as i needed. I will try to go through the arrays stuff later coz i had to finish this thing off urgently.

Cheers
Yogesh

Open the fiels in folder based on last modified date

Participate now!

Share