VBA - получить второй-последний измененный файл (FSO) без встроенных функций

Question

Я пытаюсь получить его до последнего измененного файла в папке Используя Excel VBA, мне удалось получить последний модифицированный файл, Но я не мог получить второй. Здесь ниже кода, который я использовал для получения последнего измененного файла, без использования системных функций или встроенной функции.

Sub LastFileModified() 

    Dim fso As New Scripting.FileSystemObject 
    Dim fill As Scripting.File 


    Dim i As Integer 
    Dim ForStep As Integer 

    Dim Arr() As Variant 

    ReDim Arr(fso.GetFolder("C:\Users\Shahim\Desktop\xxxx").Files.Count - 1, 1) As Variant 

    i = 0 

For Each fill In fso.GetFolder("C:\Users\Shahim\Desktop\xxxx").Files 

    Arr(i, 0) = fill.Name 
    Arr(i, 1) = CDbl(fill.DateLastModified) 

    i = i + 1 

Next fill 


Dim filename As String 
Dim Initializer As Double 

Initializer = Arr(0, 1) 

For ForStep = LBound(Arr) To UBound(Arr) 


     If Arr(ForStep, 1) > Initializer Then 

     Initializer = Arr(ForStep, 1) 
     filename = Arr(ForStep, 0) 

     End If 



Next ForStep 

Debug.Print filename 

Erase Arr 

End Sub 

Answer 1

Sub SecodLastModified() 

    Const FLDR_PATH As String = "C:\Test" 

    Dim i As Long, j As Long, fileArr() As String, maxFiles As Long 
    Dim fso As Variant, fldr As Variant, f As Variant, l1 As String, l2 As String 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set fldr = fso.GetFolder(FLDR_PATH) 
    maxFiles = fldr.Files.Count 
    ReDim fileArr(1 To maxFiles, 1 To 2) 

    i = 1 
    For Each f In fldr.Files 
     fileArr(i, 1) = f.Name 
     fileArr(i, 2) = f.DateLastModified 
     i = i + 1 
    Next 
    For i = 1 To maxFiles 
     For j = i + 1 To maxFiles 
      If fileArr(j, 2) > fileArr(i, 2) Then 
       l1 = fileArr(i, 2) 
       l2 = fileArr(i, 1) 
       fileArr(i, 2) = fileArr(j, 2) 
       fileArr(i, 1) = fileArr(j, 1) 
       fileArr(j, 2) = l1 
       fileArr(j, 1) = l2 
      End If 
     Next 
    Next 
    MsgBox fileArr(2, 1) 
End Sub 

Answer 2

оригинальный ответ не работает для меня по двум причинам.

1. fileArr (i, 2) не был объявлен датой, и иногда Excel не мог расшифровать то, что было больше. Когда я попытался смутить это как дату, он сказал, что я не могу опустить Массив.
2. Если были включены временные файлы, они не пропускали эти файлы.

Вот что сработало для меня.

Function SecodLastModified(Directory) 

Dim FileSys As FileSystemObject 
Dim objFile As File, objFile1 As File 
Dim myFolder 
Dim strFilename As String, strFolder As String, myDir As String 
Dim strFilenameFirst As String, strFilenameSecond As String, strFilenameSecond1 As String 
Dim dteFile As Date, dteFileSecond1 As Date, dteFileFirst As Date, dteFileSecond As Date 
Dim openLastFile 

'set up filesys objects 
Set FileSys = New FileSystemObject 
Set myFolder = FileSys.GetFolder(Directory) 

dteFileSecond1 = DateSerial(1900, 1, 1) 
dteFile = DateSerial(1900, 1, 1) 
'loop through each file and get date last modified. If largest date then store Filename 
For Each objFile In myFolder.Files 
    For Each objFile1 In myFolder.Files 
     ' To prevent opening temporary files 
     If objFile1.Name Like "*.xlsx" And Left(objFile1.Name, 2) <> "~$" Then 
      If objFile1.DateLastModified > objFile.DateLastModified Then 
       dteFileSecond = objFile.DateLastModified 
       strFilenameSecond = objFile.Name 
       dteFileFirst = objFile1.DateLastModified 
       strFilenameFirst = objFile1.Name 
       ' If second file date is greater than current second file, store away as the second file 
       If dteFileSecond > dteFileSecond1 Then 
        dteFileSecond1 = objFile.DateLastModified 
        strFilenameSecond1 = objFile.Name 
       End If 
      End If 
     End If 
    Next 
Next objFile 

Set SecodLastModified = Workbooks.Open(Directory & "\" & strFilenameSecond1) 
Set FileSys = Nothing 
Set myFolder = Nothing 
End Function