Klasörde İstenilen Uzantılardaki Dosyaları Listele - Microsoft Excel


Klasörün tam yolu ve uzantı listesi verildiğinde ilgili klasörde verilen uzantılardaki dosyaları listelemeye yarıyor.

Kod


Option Explicit

Sub KlasordeIstenilenUzantilardakiDosyalariListele()
    Dim i           As Long
    Dim j           As Long
    Dim dosya_isim  As String
    Dim klasor_yol  As String
    Dim dizi        As Variant
    
    klasor_yol = "C:\arsiv\dosyalar"
    klasor_yol = _
        IIf(Right$(klasor_yol, 1) = "\", klasor_yol, klasor_yol & "\")
    
    dizi = Array("3gp", "png", "mp4", "php")
    
    j = 1
    Range("A:A").Clear
    
    For i = LBound(dizi) To UBound(dizi)
        dosya_isim = Dir(klasor_yol & "*." & dizi(i))
        
        Do Until dosya_isim = ""
            Cells(j, 1) = dosya_isim
            dosya_isim = Dir
            j = j + 1
        Loop
    Next
End Sub

Kod (Açıklamalı)


Option Explicit

Sub KlasordeIstenilenUzantilardakiDosyalariListele()
    '--------------------------------------------------
    'Değişkenler
    '--------------------------------------------------
    Dim i           As Long
    Dim j           As Long
    Dim dosya_isim  As String
    Dim klasor_yol  As String
    Dim dizi        As Variant
    
    '--------------------------------------------------
    'Klasörün tam yol bilgisini değişkene aktar.
    '--------------------------------------------------
    klasor_yol = "C:\arsiv\dosyalar"
    
    '--------------------------------------------------
    'Kodun çalışabilmesi için klasör yolunun sonunda
    '"\" karakterinin bulunması önemli. Koşul ifadesi
    'kullanarak bunun olmasını garanti altına al.
    '--------------------------------------------------
    klasor_yol = _
        IIf(Right$(klasor_yol, 1) = "\", klasor_yol, klasor_yol & "\")
    
    '--------------------------------------------------
    'Listelenecek uzantıları dizi olarak tanımla.
    '--------------------------------------------------
    dizi = Array("3gp", "png", "mp4", "php")
    
    '--------------------------------------------------
    'Do Until - Loop döngüsü içinde sayaç olarak
    'kullandığımız değişken. Bu değişken sayesinde
    'satır satır ekleme yapabileceğiz.
    j = 1
    
    '--------------------------------------------------
    'Kod yazdırma işlemine başlamadan önce
    'yazdırma alanını komple temizliyoruz.
    '--------------------------------------------------
    Range("A:A").Clear
    
    '--------------------------------------------------
    'Dosyaları verilen uzantı listesine göre kontrol et.
    'Eğer verilen uzantı sağlanıyorsa ekle.
    '--------------------------------------------------
    For i = LBound(dizi) To UBound(dizi)
        
        '--------------------------------------------------
        'Dosya isimlerini belirtiyoruz. İlgili klasör içinde
        'uzantısı dizideki değere eşit olan dosya.
        '*.*                 > Bu dosya_ismi.uzanti_ismi
        '                      fark etmez, hepsini getir demek.
        '--------------------------------------------------
        '*.jpg               > jpg uzantılı tüm
        '                      dosyaları listele.
        '--------------------------------------------------
        '"C:\*." & dizi(i)   > Uzantısı dizinin i. değerine
        '                      eşit olan dosyaları listele.
        '--------------------------------------------------
        dosya_isim = Dir(klasor_yol & "*." & dizi(i))
        
        Do Until dosya_isim = ""
            Cells(j, 1) = dosya_isim
            dosya_isim = Dir
            j = j + 1
        Loop
    Next
End Sub

Etiketler
microsoft excel açıklamalı içerik microsoft excel vba