Uzantı Listesine Göre Dosya Listele - Microsoft Excel

Bir klasördeki dosyaları verilen uzantı listesindeki uzantılara göre A sütununda listeliyor. Eğer dosyanın uzantısı uzantı listesindeki öğelerden birisiyle eşleşiyorsa listeye dahil ediliyor.

Sub UzantiListesineGoreDosyaListele()
    'Değişken Tanımlamaları
    Dim fso       As Object
    Dim klasor    As Object
    Dim yol       As String
    Dim uzantilar As Variant
    Dim dosya     As Object
    Dim j         As Integer
    Dim sayac     As Long
    
    
    'Listeye Dahil Edilecek Uzantılar
    uzantilar = Array(".xls", ".xlsx", ".xlsm", ".pdf", ".docx", _
                      ".png", ".txt", ".jpg", ".rar", ".zip", _
                      ".mp4", ".xml", ".json", ".sql", ".part")
                      
    'Değişken Tanımlamaları
    Set fso = CreateObject("Scripting.FileSystemObject")
    yol = "C:\"
    sayac = 1
    Set klasor = fso.Getfolder(yol)
    
    'Alan Temizleme İşlemi
    Range("A:A").Clear
    
    'Döngü İle Dosya Tespit İşlemi
    For Each dosya In klasor.Files
        For j = LBound(uzantilar) To UBound(uzantilar)
            If dosya.Name Like "*" & uzantilar(j) Then
                Range("A" & sayac) = dosya.Name
                sayac = sayac + 1
            End If
        Next
    Next
End Sub

Sub UzantiListesineGoreDosyaListele()
    'Değişken Tanımlamaları
    Dim fso       As Object
    Dim klasor    As Object
    Dim yol       As String
    Dim uzantilar As Variant
    Dim dosya     As Object
    Dim j         As Integer
    Dim sayac     As Long
    
    '--------------------------------------------------
    'Listeye Dahil Edilecek Uzantılar
    'Listelenmesini istediğimiz dosya uzantılarını
    'bir dizi üzerinde listeledik ve klasördeki
    'dosyaları kontrol ederken de yine bu
    'diziden faydalanacağız.
    '--------------------------------------------------
    uzantilar = Array(".xls", ".xlsx", ".xlsm", ".pdf", ".docx", _
                      ".png", ".txt", ".jpg", ".rar", ".zip", ".mp4", _
                      ".xml", ".json", ".sql", ".part")
                      
    
    '--------------------------------------------------
    'Listeleme için kullanılacak nesnemizi ayarlıyoruz.
    '--------------------------------------------------
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '--------------------------------------------------
    'Klasör yolunu tanımlıyoruz.
    'Siz de bu yolu ihtiyacınıza göre değiştirin.
    '--------------------------------------------------
    yol = "C:\"
    
    '--------------------------------------------------
    'A sütununa listeleme yaparken satır numarasını
    'belirlemek için kullanacağımız değişkeni ayarladık.
    '--------------------------------------------------
    sayac = 1
    
    '--------------------------------------------------
    'Klasör ayarlamasını yaptık.
    'Yukarıda oluşturduğumuz fso nesnesi ve yol
    'bilgisini ayarladıktan sonra klasör ayarını
    'yapabilir hale geldik.
    '--------------------------------------------------
    Set klasor = fso.Getfolder(yol)
    
    '--------------------------------------------------
    'Yeni bir listeleme işlemi başlamadan önce
    'A sütunundaki tüm verileri temizliyoruz.
    'Bu potansiyel bir karışıklığın önüne de
    'geçmek için önemli. Örneğin "sebzeler"
    'klasöründe 10 dosya var ve "meyveler"
    'klasöründe de 5 dosya var. Eğer siz
    '--------------------------------------------------
    Range("A:A").Clear
    
    '--------------------------------------------------
    'Döngü İle Dosya Tespit İşlemi
    'Klasördeki her dosya için işlem yapılacak.
    '--------------------------------------------------
    For Each dosya In klasor.Files
    
        '--------------------------------------------------
        'Her bir dosyayı dizideki bütün
        'uzantılar için kontrol et.
        '--------------------------------------------------
        For j = LBound(uzantilar) To UBound(uzantilar)
            
            '--------------------------------------------------
            'Eğer uzantıda eşleşme olursa işlem yap.
            '--------------------------------------------------
            If dosya.Name Like "*" & uzantilar(j) Then
                
                '--------------------------------------------------
                'Sıradaki boş alana dosyanın adını ekle.
                '--------------------------------------------------
                Range("A" & sayac) = dosya.Name
                
                '--------------------------------------------------
                'sayac değişkenini 1 artırdık.
                'Böylelikle döngü çalışmaya devam ettikçe
                'A sütununda sonraki boş satır seçilecek.
                '--------------------------------------------------
                sayac = sayac + 1
            End If
        Next
    Next
End Sub