Finding most recent file name (File1_YYYYMMDD), update and SaveAs for multiple files

[ddander54]

I have 16 files that I automatically Open one at a time, update and SaveAs with a new filename in the format of File1_YYYYMMDD, File2_YYYYMMDD, etc.

As long as I specifically call out the file name to open (ie, File1_20210609.xlsx), my code works pretty well (not sure if its the most efficient code, but it only takes 1 click and 16 files are updated in 11.5 minutes)

I am currently trying to modify the code to loop thru the files of the 'same' name (ie, File1_20210608.xlsx, File1_20210609.xlsx) to find the most recent file, then open it, update it, and finally SaveAs File1_20210610...then move on to File2_....etc.

My problem with the code that I'm adding to find the most recent file, it works for the first file, but then doesn't update the LatestFile variable for subsequent files, so it keeps opening the first file and saving it as File2_, File3_, etc.

TIA for any help,
Don

Code with the loop to find the most recent filename.....

Option Explicit


Sub Test67()


Dim sFolder As String
Dim objExcel As Object
Dim objWorkbook As Object
Dim wb As Excel.Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("C:\MyExcelFiles\Test67.xlsx")
Set ws = wb.Sheets("Start")
Dim answer As Integer
Dim StartTime As Double
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date


Set objExcel = CreateObject("Excel.Application")


ws.Range("A1").ClearContents  'ClearContents clears data, but leaves the formatting--- Clear removes contents and formatting
ws.Range("L3:L20").Copy ws.Range("J3:J20")
ws.Range("K3:N20").ClearContents  'ClearContents clears data, but leaves the formatting--- Clear removes contents and formatting




'#1
StartTime = Timer


'Specify the path to the folder
sFolder = "C:\MyExcelFiles\Test\"
    
'Make sure that the path ends in a backslash
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    
'Get the first Excel file from the folder
MyFile = Dir(sFolder & "Book1_*.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(sFolder & 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
Set objWorkbook = Workbooks.Open(sFolder & LatestFile)
ActiveWorkbook.RefreshAll
'objWorkbook.Sheets("query1").recalc
Application.DisplayAlerts = False
objWorkbook.SaveAs sFolder & "Book1_" & Format(Date, "YYYYMMDD") & ".xlsx"
Application.DisplayAlerts = True
objWorkbook.Close


'Application.Wait (Now + TimeValue("0:00:05"))
ws.Range("A1") = 1
ws.Range("K3") = 1
ws.Range("M3") = sFolder & "Book1_" & Format(Date, "YYYYMMDD") & ".xlsx"
ws.Range("N3") = sFolder & LatestFile
ws.Range("L3") = Format((Timer - StartTime) / 86400, "hh:mm:ss")




'#6
StartTime = Timer
sFolder = "C:\MyExcelFiles\Test\"
    
'Make sure that the path ends in a backslash
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    
'Get the first Excel file from the folder
MyFile = Dir(sFolder & "Book2_*.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(sFolder & 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


Set objWorkbook = Workbooks.Open(sFolder & LatestFile)
ActiveWorkbook.RefreshAll
'objWorkbook.Sheets("query1").recalc
Application.DisplayAlerts = False
objWorkbook.SaveAs sFolder & "Book2_" & Format(Date, "YYYYMMDD") & ".xlsx"
Application.DisplayAlerts = True
objWorkbook.Close


Application.Wait (Now + TimeValue("0:00:05"))
ws.Range("A1") = 2
ws.Range("K5") = 2
ws.Range("M5") = sFolder & "Book2_" & Format(Date, "YYYYMMDD") & ".xlsx"
ws.Range("N5") = sFolder & LatestFile
ws.Range("L5") = Format((Timer - StartTime) / 86400, "hh:mm:ss")


'#7
StartTime = Timer
sFolder = "C:\MyExcelFiles\Test\"
    
'Make sure that the path ends in a backslash
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    
'Get the first Excel file from the folder
MyFile = Dir(sFolder & "Book3_*.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(sFolder & 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


Set objWorkbook = Workbooks.Open(sFolder & LatestFile)
ActiveWorkbook.RefreshAll
'objWorkbook.Sheets("query1").recalc
Application.DisplayAlerts = False
objWorkbook.SaveAs sFolder & "Book3_" & Format(Date, "YYYYMMDD") & ".xlsx"
Application.DisplayAlerts = True
objWorkbook.Close


'Application.Wait (Now + TimeValue("0:00:05"))
ws.Range("A1") = 3
ws.Range("K7") = 3
ws.Range("M7") = sFolder & "Book3_" & Format(Date, "YYYYMMDD") & ".xlsx"
ws.Range("N7") = sFolder & LatestFile
ws.Range("L7") = Format((Timer - StartTime) / 86400, "hh:mm:ss")




End Sub