Klasördeki Dosyaları Listboxa Alırken Oluşturma Tarihine Göre Sıralamak

1 2

Klasördeki dosyaları listboxa alırken oluşturma tarihine göre Z-->A sıralayarak almak nasıl olmalı
şu kod dosyaları alıyor

Public Function FillDirToTable(lst As listbox, colDirList As Collection _

                                , ByVal strFolder As String _

                                , strFileSpec As String _

                                , bIncludeSubfolders As Boolean _

                                , Optional criteria As String = "")

On Error GoTo Err_Handler



    Dim strTemp As String

    Dim colFolders As New Collection

    Dim vFolderName As Variant



    strFolder = TrailingSlash(strFolder)



    'strTemp returns the FileName matching the FileSpec in strFolder

    strTemp = Dir(strFolder & strFileSpec)      'produces ..Folder\*.FileSpec



    Do While strTemp <> vbNullString        'as long as FileNames are returned

        

        If (InStr(strTemp, criteria) > 0 Or criteria = "") Then lst.AddItem strFolder & strTemp

        

        strTemp = Dir       'Recursively call the Dir() Function

    Loop

    

    If bIncludeSubfolders Then

        strTemp = Dir(strFolder, vbDirectory)

        Do While strTemp <> vbNullString

            'If Sub-Folder, add to colFolders Collection

            If (strTemp <> ".") And (strTemp <> "..") Then

                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then

                    colFolders.Add strTemp

                End If

            End If

            strTemp = Dir          'Recursively call the Dir() Function

        Loop

    

        'Call function recursively for each subfolder.

        For Each vFolderName In colFolders

            '..Folder\Sub-Folder\----------------'

            Call FillDirToTable(lst, colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)

        Next vFolderName

    End If

    

    



Exit_Handler:

  Exit Function



Err_Handler:

  Resume Exit_Handler

End Function

Kod:
Sub sırala()

Dim oFS As Object

Dim sFil As String

Dim liste As Object

Set liste = CreateObject("System.Collections.ArrayList")

sFil = Dir(ThisWorkbook.Path & "\*.xl*")

Set oFS = CreateObject("Scripting.FileSystemObject")

Do While sFil <> ""

liste.Add CDbl(oFS.GetFile(ThisWorkbook.Path & "\" & sFil).DateCreated) & "*" & sFil

sFil = Dir

Loop

liste.Sort

For i = liste.Count - 1 To 0 Step -1

Sonuc = Split(liste(i), "*")

MsgBox "Dosya Adı " & Sonuc(1)

MsgBox "Oluşturma Tarihi " & CDate(Sonuc(0))

Next

End Sub

Oluşturma tarihini başa alıp, sıralayınca doğru sonuç veriyor. Ben tek klasöre göre düzenledim. Kendi dosyanıza göre uyarlayın.

Sayın @accessman yukardaki kodları yeniledim.

sayın @alicimri 'nin çalışmasına ek olarak aşağıdaki kodları deneyebilirsiniz
Önce bir modül oluşturup aşağıdaki kodları ekleyin

Function DosyaDonguSirali(AnaKls, IncludeSubFolders As Boolean, Optional ListeKutusu As Object)



Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(AnaKls)

Set objfile = CreateObject("Scripting.FileSystemObject")

Set objSubFolder = CreateObject("Scripting.FileSystemObject")

    Set HdfLst = ListeKutusu

    

    'Klasördeki dosya adlarını alma

    For Each objfile In objFolder.Files

      TxtAdres = Left(objfile.Path, InStrRev(objfile.Path, "\") - 1)

      StrVeri = TxtAdres & ";" & objfile.Name & ";" & objfile.DateCreated

        With HdfLst

        StrSay = .ListCount

            

            If StrSay = 0 Then

                .AddItem StrVeri

            Else

                For xIndx = 0 To StrSay - 1

                If CDbl(CDate(.Column(2, xIndx))) < CDbl(objfile.DateCreated) Then

                    .AddItem StrVeri, xIndx

                    Exit For

                Else

                If xIndx = StrSay - 1 Then .AddItem StrVeri

                End If

                Next xIndx

            End If

        End With

    Next objfile

    

    'Alt klasörlerde dolaşma

    If IncludeSubFolders Then

        For Each objSubFolder In objFolder.SubFolders

            Call DosyaDonguSirali(objSubFolder, True, ListeKutusu)

        Next objSubFolder

    End If

    

End Function

sonra da her hangi bir formdaki her hangi bir liste kutusuna sıralı eklemek için aşağıdaki kodla çağırmayı deneyin

Private Sub BtnListele_Click()

Me.ListeKutusuAdi.RowSource = ""

DosyaDonguSirali KlasorAdi, True, Me.ListeKutusuAdi

End Sub

kodların özelliği modülde yer almasından dolayı her yerde kullanabilmenizdir.

denedikten sonra lütfen olumlu yada olumsuz geri bildirimde bulunun
iyi bayramlar

Hayırlı Bayramlar Arkadaşlar
Emekleriniz için çok teşekkürler sn@alicimri ve sn.@berduş çok teşekkürler

En kısa zamanda deneyeceğim çok teşekkürler

sn. @berduş şu hatayı veriyor

Kodları tekrar kontrol eder misiniz? Ben cok denedim null hatası hiç vermedi. Null hatası veriyorsa olmayan veriyi ceviremedigi için oluyordur, arada atladığınız bir yer olabilir. Bazen kopyala yapıştırma alırken hatalı olabiliyor.
Olmazsa uygun bir zamanda dosyayı tekrar kontrol edip yüklemeye calisirim

1 2