Klasörün tam yolu ve uzantı listesi verildiğinde ilgili klasörde verilen uzantılardaki dosyaları listelemeye yarıyor.
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
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