VBA：如何打开文件夹中最近的两个 excel 文件

Question

I have trying to open the most recent two excel file in the folder so far i did open the latest file in folder but i have to open 2nd latest file in folder. refer below code. please suggest how to open 2nd most recent file?

Sub findingdiff()
Dim FileSys, objFile, myFolder, c As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
  FolderName = ("C:\Users\ashokkumar.d\Desktop\Test\do\")
                Set FileSys = CreateObject("Scripting.FileSystemObject")
                Set myFolder = FileSys.GetFolder(FolderName)

        dteFile = DateSerial(1900, 1, 1)
        For Each objFile In myFolder.Files
            If InStr(1, objFile.Name, ".xls") > 0 Then
                If objFile.DateLastModified > dteFile Then
                    dteFile = objFile.DateLastModified
                    strFilename = objFile.Name
                End If
            End If
        Next objFile
'opening of latest file in the folder

                Set wb2 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename)

End Sub

Answer 1

You can do it in one pass

Sub findingdiff()
Dim FileSys, objFile, myFolder, c As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim strFilename, strFilename2
  FolderName = ("C:\Users\ashokkumar.d\Desktop\Test\do\")
                Set FileSys = CreateObject("Scripting.FileSystemObject")
                Set myFolder = FileSys.GetFolder(FolderName)

        dteFile = DateSerial(1900, 1, 1)
        For Each objFile In myFolder.Files
            If InStr(1, objFile.Name, ".xls") > 0 Then
                If objFile.DateLastModified > dteFile Then
                    dteFile = objFile.DateLastModified
                    strFilename2 = strFilename
                    strFilename = objFile.Name
                End If
            End If
        Next objFile
'opening of latest file in the folder

  Set wb1 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename)              
 Set wb2 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename2)

End Sub

Answer 2

Here's another way to tackle the problem. Create a sorted list and then process the first 2 files:

Sub Lastest2Files()
   Dim rs As ADODB.Recordset
   Dim fs As FileSystemObject
   Dim Folder As Folder
   Dim File As File

   'create a recordset to store file info
   Set rs = New ADODB.Recordset
   rs.fields.Append "FileName", adVarChar, 100
   rs.fields.Append "Modified", adDate
   rs.Open

   'build the list of files and sort
   Set fs = New FileSystemObject
   Set Folder = fs.GetFolder("C:\aatemp")

   For Each File In Folder.Files
      rs.AddNew
      rs("FileName") = File.Path
      rs("Modified") = File.DateLastModified
   Next

   rs.Sort = "Modified DESC"

   'process the first 2 files
   rs.MoveFirst
   Set wb2 = Workbooks.Open(rs.fields("FileName").value)
   rs.MoveNext
   Set wb2 = Workbooks.Open(rs.fields("FileName").value)
End Sub

Answer 3

I modified findingdiff when the first file it encounter is most recent; Otherwise findingdiff don't get the second most recent. Hope this helps...

Private Sub SortDictionaryByKey() '220926

' http://www.xl-central.com/sort-a-dictionary-by-key.html Dim ProcName As String: ProcName = Mod_Name & "SortDictionaryByKey" & Debug_Output_Seperator '220926 Debug.Print TimeStamp & ProcName 'Set a reference to Microsoft Scripting Runtime by using 'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
Dim Dict As Scripting.Dictionary
Dim TempDict As Scripting.Dictionary
Dim KeyVal As Variant
Dim Arr() As Variant
Dim Temp As Variant
Dim Txt As String
Dim i As Long
Dim j As Long

'Create an instance of the Dictionary
Set Dict = New Dictionary

'Set the comparison mode to perform a textual comparison
Dict.CompareMode = TextCompare

Dim FileSys, objFile, myFolder, c As Object Dim FolderName As Variant Dim dteLatest As Variant ''''''''''''''''''''''''''''''''

FolderName = FolderSelect_Source_Destination '220922

    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FileSys.GetFolder(FolderName)

    With myFolder
    
    End With
    dteLatest = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
        '220921
        With objFile
            If InStr(1, .name, PPT_Extension) > 0 Then
                Dict.Add .DateLastModified, .Path
                Debug.Print TimeStamp & ProcName & .Path
                    dteLatest = .DateLastModified

            End If
        End With
    Next objFile
    


'Allocate storage space for the dynamic array
ReDim Arr(0 To Dict.Count - 1)

'Fill the array with the keys from the Dictionary
For i = 0 To Dict.Count - 1
    Arr(i) = Dict.Keys(i)
Next i

'Sort the array using the bubble sort method
For i = LBound(Arr) To UBound(Arr) - 1
    For j = i + 1 To UBound(Arr)
        If Arr(i) > Arr(j) Then
            Temp = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Temp
        End If
    Next j
Next i

'Create an instance of the temporary Dictionary
Set TempDict = New Dictionary

'Add the keys and items to the temporary Dictionary,
'using the sorted keys from the array
For i = LBound(Arr) To UBound(Arr)
    KeyVal = Arr(i)
    TempDict.Add Key:=KeyVal, Item:=Dict.Item(KeyVal)
Next i

'Set the Dict object to the TempDict object
Set Dict = TempDict

'Build a list of keys and items from the original Dictionary
For i = 0 To Dict.Count - 1
    Txt = Txt & Dict.Keys(i) & vbTab & Dict.Items(i) & vbCrLf
Next i

With Dict
    str_Recent_FileFullName(1) = .Items(.Count - 1)
    str_Recent_FileFullName(2) = .Items(.Count - 2)
    Stop
'Display the list in a message box
End With
MsgBox Txt, vbInformation

Set Dict = Nothing
Set TempDict = Nothing
Set KeyVal = Nothing
Erase Arr()
Set Temp = Nothing

Set FileSys = Nothing

End Sub