Macro to open latest file within a folder

Hi Guys,
I have case where there are excel files arranged like this within a folder. For example:-

XA11_df01.xlsx
XA11_df02.xlsx
XA11_df03.xlsx
.
.
XB11_df01.xlsx
XB11_df02.xlsx
.
.
YA11_df01.xlsx
YA11_df02.xlsx
.
.
YB11_df01.xlsx
YB11_df02.xlsx
.
.

All these files are located in one folder. I want to write a macro to open the latest excel files based on lastmodified date and time for each file name like XA11, XB11, YA11, YB11. I only want to do this for excel files (".xlsx") within a folder as there are other pdf files also in the folder. I want macro to open the latest file for first file name run my code on it , then open latest file for second file name and run my code on it so on.


Any help will be highly apprecited.

Thanks.
Roop

Hello Roop,

This macro will open the most recent ".xlsx" file in the given directory based on the file name to left of the underscore. You will need to change the file path and add a call to your macro in this one. At the bottom you will see a comment (in bold text). This is where you need to add the call.

'Written: January 22, 20111
'Author:  Leith Ross

Sub OpenMostRecent()

  Dim Dict As Object
  Dim DLM As Variant
  Dim FileName As String
  Dim FilePath As String
  Dim FileSpec As Variant
  Dim FileType As String
  Dim FSO As Object
  Dim Key As Variant
  Dim MostRecent As Double
  Dim R As Long
  Dim RegExp As Object
  
    FilePath = "C:\"
    FileType = "*.xlsx"
    
      Set Dict = CreateObject("Scripting.Dictionary")
      Dict.CompareMode = vbTextCompare
    
      Set FSO = CreateObject("Scripting.FileSystemObject")
    
      Set RegExp = CreateObject("VBScript.RegExp")
      RegExp.IgnoreCase = True
      RegExp.Pattern = "([0-9A-Z]+).+"
      
      FilePath = IIf(Right(FilePath, 1) <> "\", FilePath & "\", FilePath)
      FileName = Dir(FilePath & FileType)
      
        Do While FileName <> ""
          If RegExp.Test(FileName) = True Then
            Key = RegExp.Replace(FileName, "$1")
            DLM = FSO.Get(FileName).DateLastModified
              If Not Dict.Exists(Key) Then
                ReDim FileSpec(1)
                  FileSpec(0) = FileName
                  FileSpec(1) = DLM
                Dict.Add Key, FileSpec
              Else
                FileSpec = Dict(Key)
                  If DLM > FileSpec(1) Then
                    FileSpec(0) = FileName
                    FileSpec(1) = DLM
                  End If
                Dict(Key) = FileSpec
              End If
          End If
          FileName = Dir()
        Loop
      
      For Each Key In Dict.Keys
        FileSpec = Dict(Key)
        Workbooks.Open FilePath & FileSpec(0)
        'Call Macro1  '<<<<< Replace Macro1 with the name of your macro
      Next Key
      
  Set Dict = Nothing
  Set FSO = Nothing
  Set RegExp = Nothing
  
End Sub