search folder for latest file creation date, not latest modified date

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
2,004
Office Version
  1. 365
Platform
  1. Windows
The other day i found a snippet of code that has helped me locate the latest version of all files in a particular folder. How do i amend this code so that the file that is ultimately opened is the one that has been created latest, irrespective of when files have been modified.

https://www.mrexcel.com/forum/excel-questions/1111630-workbook-close-not-working.html

Code:
Option Explicit
Sub reportpackage()
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim MLPwkb As String, SourceWb As Workbook
    
    Set SourceWb = ThisWorkbook
   
    MyPath = \\FPMB1FNP02\Groups$\Internal_Management_Reports\DailyMLP
      
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        
    MyFile = Dir(MyPath & "*.xls", vbNormal)
    
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If

    Do While Len(MyFile) > 0
         
        LMD = FileDateTime(MyPath & MyFile)
          
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
       
        MyFile = Dir
        
    Loop
    
    MLPwkb = MyPath & LatestFile
   With Workbooks.Open(LatestFile)
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
We have to use FileSystemObject to determine a file's creation date. Add this function:

Code:
Public Function Get_Latest_Workbook(searchPath As String) As String

    Dim FSO As Object
    Dim FSfolder As Object
    Dim FSfile As Object
    Dim latestDate As Date
            
    Get_Latest_Workbook = ""
    latestDate = 0
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FSO.GetFolder(searchPath)
    
    For Each FSfile In FSfolder.Files
        If FSfile.Name Like "*.xls" And FSfile.DateCreated > latestDate Then
            Get_Latest_Workbook = FSfile.path
            latestDate = FSfile.DateCreated
        End If
    Next
    
End Function
and call it like this from your code:
Code:
    MyPath = "\\FPMB1FNP02\Groups$\Internal_Management_Reports\DailyMLP"  'no need to add trailing backslash
    LatestFile = Get_Latest_Workbook(MyPath)
    If LatestFile <> "" Then
        Workbooks.Open LatestFile
    Else
        MsgBox "No *.xls files found in " & MyPath
    End If
 
  • Like
Reactions: ajm
Upvote 0
We have to use FileSystemObject to determine a file's creation date. Add this function:

Code:
Public Function Get_Latest_Workbook(searchPath As String) As String

    Dim FSO As Object
    Dim FSfolder As Object
    Dim FSfile As Object
    Dim latestDate As Date
            
    Get_Latest_Workbook = ""
    latestDate = 0
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FSO.GetFolder(searchPath)
    
    For Each FSfile In FSfolder.Files
        If FSfile.Name Like "*.xls" And FSfile.DateCreated > latestDate Then
            Get_Latest_Workbook = FSfile.path
            latestDate = FSfile.DateCreated
        End If
    Next
    
End Function
and call it like this from your code:
Code:
    MyPath = "\\FPMB1FNP02\Groups$\Internal_Management_Reports\DailyMLP"  'no need to add trailing backslash
    LatestFile = Get_Latest_Workbook(MyPath)
    If LatestFile <> "" Then
        Workbooks.Open LatestFile
    Else
        MsgBox "No *.xls files found in " & MyPath
    End If

thanks John. does
Code:
    MyPath = "\\FPMB1FNP02\Groups$\Internal_Management_Reports\DailyMLP"  'no need to add trailing backslash
    LatestFile = Get_Latest_Workbook(MyPath)
    If LatestFile <> "" Then
        Workbooks.Open LatestFile
    Else
        MsgBox "No *.xls files found in " & MyPath
    End If

completely replace

Rich (BB code):
 MyPath = \\FPMB1FNP02\Groups$\Internal_Management_Reports\DailyMLP      
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        
    MyFile = Dir(MyPath & "*.xls", vbNormal)
    
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If

    Do While Len(MyFile) > 0
         
        LMD = FileDateTime(MyPath & MyFile)
          
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
       
        MyFile = Dir
        
    Loop
    
    MLPwkb = MyPath & LatestFile
   With Workbooks.Open(LatestFile)
 
Last edited:
Upvote 0
not yet. was at a different site yesterday. will be doing so this morning though. thank you for your help. i'll close the loop here when i have done so.
 
Upvote 0
John, many thanks. works like a charm! happy days.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top