Skip to main content

AccessTr.neT


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

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

Çözüldü #1
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
@benbendedeilem
Son Düzenleme: 22/05/2020, 16:15, Düzenleyen: accessman.
Cevapla
#2
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.
Son Düzenleme: 24/05/2020, 12:06, Düzenleyen: alicimri. (Sebep: Tarihi Metin olarak gördüğünden yanloş sonuç veriyordu.)
Cevapla
#3
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
Cevapla
#4
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
@benbendedeilem
Cevapla
#5
sn. @berduş şu hatayı veriyor

[Resim: do.php?img=10249]
@benbendedeilem
Cevapla
#6
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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task