Use partial name to Search and locate newest file within multi layered subfolders

[Buffalo13]

With the code I found below, I'm attempting to Find and Locate and Open the newest matching file (Creation Date) within a few layers of subfolders. I tried altering the code I found below, but I get "No files were found...". I have 2 tabs, "App List" and "Database". I would like to have the program start in cell A2 on the "App List" tab as the partial file name for the search in the subfolders, then open the file so I can copy and paste the data (which I can do myself) in the Database tab. I will eventually remove the code "MsgBox "No files were found...", but for now I'm using it to see if any files were found. Could someone please help me do the following below? I know how to do simple Vb coding, but after many attempts, I can't even get the program to grab the newest file. Please help!! I'm stuck!!!

1. Using the app name in Cell A2 on the "App List" tab as the search criteria. Find and Open the "Newest" matching file located within multi-layered subfolders (The "Db2" folder contains 2 folders (2020 and 2021) and those folders contain monthly subfolders, please see screenshot below).
2. Once the newest file is found and opened, I would like to copy the data and paste it into the "Database" tab, along with the filename (please see bottom right screenshot below).
3. Then loop remaining search criteria in column A on the "App List" tab until all apps have been processed (I plan on starting with the "_Dev" files, then I will run a separate macro for the other report environments (Prod, QV and SIT).

Sub Folders

Paste Range ("Database" tab)

Sub OpenLatestFile3()

'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date

'Specify the path to the folder
MyPath = "L:\Reports\DB2\"

'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & ThisWorkbook.Sheets("App List").Range("A2").Text & ("~DB2_Dev_") & "*.xlsx", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close


'Specify the path to the folder
MyPath = "L:\Reports\DB2\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & ThisWorkbook.Sheets("App List").Range("A2").Text & ("~DB2_Dev_") & "*.xlsx", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close

End Sub

 

[Buffalo13]

OK, I found another code on this forum created by "RickXL" (Thank You Rick for this awesome code!!) that I was able to alter and added my file path and name and got it to open the newest file, but it's pulling the file by "Month(objFile.DateCreated) = Month(Date)". Does anyone know how to change it to pull by "Day"? I have made dozens of attempts, but I can't figure how to pull newest file by Day. Could someone please help me!!

Sub Demo()
    Dim FSO As Object
    Dim CurrentFile As String
    Dim Filename As String
    

    Set FSO = CreateObject("Scripting.FileSystemObject")
    TraverseFolders FSO.GetFolder("L:\Reports\DB2"), ThisWorkbook.Sheets("App List").Range("A2").Text & "*~DB2_Dev_*.xlsx", CurrentFile
End Sub
Function TraverseFolders(folder As Variant, Mask As String, CurrentFile As String)
    Dim objFile     As Object
    Dim SubFolder   As Object
    
    For Each objFile In folder.Files
        If objFile.Name Like Mask And _
            Year(objFile.DateCreated) = Year(Date) And Month(objFile.DateCreated) = Month(Date) Then
'                CurrentFile = Folder & "\" & objFile.Name
                    Workbooks.Open objFile
                Exit Function
        End If
    Next
    For Each SubFolder In folder.subfolders
        If CurrentFile <> "" Then Exit Function
        TraverseFolders SubFolder, Mask, CurrentFile
    Next
End Function