Seçtiğim Klasörün Alt Klasörleri olup olmadığını denetlemek

[Ergün Güler]

Aşağıdaki kodlar ile Seçtiğim Klasör ve Alt Klasörlerin dosyalarını listeliyorum.
İstediğim şu Seçtiğim Klasörün alt klasörü olup olmadığını nasıl denetleyebilirim?

Alt klasör "var" veya "yok" gibi. Varsa sayısı gibi.

Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

Sub dosya_listele_diger()
Dim klasor As Object
Dim dosya As String
Dim i As Long
check_say = 0

Set klasor = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Klasör Seçiniz...", 1) ' gözatma klasörü
                    
If klasor Is Nothing Then Exit Sub

   Liste (klasor.Items.Item.Path)
   If MsgBox(klasor & " Klasöründeki Alt Klasörlerin Dosyalarını da Listelemek İstiyor musunuz?", vbYesNo, "LİSTELEME İŞLEMİ") = vbYes Then
   AltListe (klasor.Items.Item.Path)
   End If
   
  Set klasor = Nothing
End Sub

Private Sub Liste(anayol As String) 'Seçilen klasör içindeki dosyaları listeleme modülü
Dim dosya As String, i As Long, f As Object
Dim lv As ListView
Set lv = DIPForm.ListView1

    dosya = Dir(anayol & "\*.*")  ' Seçilen klasördeki tüm dosyaları bulma
    lv.ListItems.Clear
    i = 1
    While dosya <> ""
        DoEvents
        lv.ListItems.Add
        lv.ListItems(i) = anayol & "\"
        lv.ListItems(i).SubItems(1) = dosya
        'lv.ListItems(i).SubItems(3) = FileDateTime(dosya)
        dosya = Dir
        i = i + 1
    Wend
    
End Sub

Private Sub AltListe(altyol As String) 'Seçilen klasör içindeki alt klsörlerin içindeki dosyaları listeleme modülü
Dim fL As Object, f As Object, dosya As String, j As Long
Dim lv As ListView
Set lv = DIPForm.ListView1

Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(altyol).SubFolders
On Error GoTo sonraki

For Each f In fL
    dosya = Dir(f.Path & "\*.*")  ' Seçilen klasördeki tüm dosyaları bulma
        
    While dosya <> ""
        DoEvents
        
        j = lv.ListItems.Count + 1
        lv.ListItems.Add
        lv.ListItems(j) = f & "\"
        lv.ListItems(j).SubItems(1) = dosya
        'lv.ListItems(j).SubItems(3) = FileDateTime(dosya)
         
        dosya = Dir
    Wend
    
    AltListe (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

 

[leumruk]

Merhaba,
Aşağıdaki kodla seçtiğiniz klasörde bulunan tüm alt klasör ve onların içinde bulunan tüm klasörlerin sayısına ulaşabilirsiniz.

Sub Alt_Klasör_Sayısı()
Set ds = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("Shell.Application")
Set hdf = shl.BrowseForFolder(0, "Lütfen bir klasör seçiniz!", 0)
If hdf Is Nothing Then
Exit Sub
Else
yol = hdf.self.Path
End If
x = 0
Application.ScreenUpdating = False
If ds.GetFolder(yol).subfolders.Count = 0 Then GoTo Son
Do
Tekrar:
If ds.GetFolder(yol).subfolders.Count > 0 Then
    For Each kls In ds.GetFolder(yol).subfolders
        klslst = klslst & "{" & kls
    Next
End If
x = x + 1
deg = Split(klslst, "{")
yol = deg(x)
If ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x
Son:
MsgBox "Klasör sayısı: " & x
End Sub

 

[halit3]

Alternatif olması dileğiyle

kod:

Dim say
Sub Klasör_Listele2()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
 Kaynak = Klasor.self.Path
  If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
   If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
    Columns("A:A").ClearContents
    say = 0
    Liste (Kaynak)
    Set Klasor = Nothing
    MsgBox say & " adet klasor var"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
On Error GoTo sonraki
 For Each f In fL
 say = say + 1
 j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
 Cells(j, 1) = f.Name
 Liste (f.Path)
sonraki:
 Next
Set fL = Nothing
End Sub

 

[Ergün Güler]

Merhaba,
Aşağıdaki kodla seçtiğiniz klasörde bulunan tüm alt klasör ve onların içinde bulunan tüm klasörlerin sayısına ulaşabilirsiniz.

Sayın leumruk,
Çok teşekkür ederim.
aradığım kod:

ds.GetFolder(yol).subfolders.Count

bu idi. Keşke tüm alt klasörü sayan tek bir olsa idi. Yoksa böyle bir kod var mıdır?
VBA ve EXCEL kodlarında nokta(.)'dan sonra çıkan kodlar "CreateObject" nesnelerinde çıkmyor. Peki bunları nasıl öğrenebiliriz?

2.sorum: aşağıdaki kodlarda "{" birleştirip sonra ayırmışsınız. mantığnı anlayamadım. Biraz anlatır mısınız?

If ds.GetFolder(yol).subfolders.Count > 0 Then
    For Each kls In ds.GetFolder(yol).subfolders
        klslst = klslst & "{" & kls
    Next
End If
x = x + 1
deg = Split(klslst, "{")
yol = deg(x)

 

[halit3]

Her iki koduda ekli dosyaya ekledim
Bu dosyanın yanında aaaaa klasörü var ve bu klasörün içindede farklı klasörler mevcut seçimi aaaaa klasörü yapınca sonuç ise çok farklı çıkıyor.

 

[leumruk]

Merhaba,
Kırmızı kısmı sildiğinizde sorun kalmayacaktır.

If [COLOR="DarkRed"][B]x = 1 And [/B][/COLOR]ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar

If ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar

Ergun Bey 2. sorunuzun cevabı: { bu sembolün pek bir anlamı yok bunun yerine başka karakter de kullanabilirsiniz. Çok kullanılmayan bir karakter olduğu için ben bunu tercih ettim. Split kullanarak klasör adreslerini hafızaya alıyorum. Zaman kaybı olmaması için hafızaya alma işlemi devam ettiği sırada x değerine göre hafızadaki adresleri döngü içinde yol ismine tanımlıyorum. Böylelikle döngü içinde tüm klasörler kontrol edilmiş oluyor. Dilerseniz klasörleri listeleme işini de bu kodlarla yapabilirsiniz.
Listeleme için de yol tanımının altına

Cells(x, 1) = deg(x)

satırını eklemeniz yeterli. Tabi kodun başına 1. sütunu temizleme kodu eklemeniz de faydalı olacaktır.

 

[leumruk]

Ergun Bey,
1. sorunuzun cevabı: Office 2003'te Hazırladığım programlarda "Filesearch" komutunu kullanıyordum. Bu komut istediğiniz pek çok eylemi gerçekleştirebiliyordu. Ancak bu kod office 2007 ve üzerindeki office programlarından kaldırıldı. Dolayısıyla kullanılabilirlik alanı kısıtlanmış oldu. Alternatif olarak sayma işlemini, dosya ve klasörleri listeleme işlemini gerçekleştirmek için kullanıcı tanımlı kodlamalar yapıyorum. Sayma işleminizi aşağıdaki sistemle gerçekleştirebilirsiniz. Ekleyeğim kodlamayı herhangi bir modüle kopyalayarak, o dosyadaki tüm makrolarınızda tek bir satır kullanarak sayma işleminizi gerçekleştirebilirsiniz.

Function AllFolderCount(klsr As Variant)
Set ds = CreateObject("Scripting.FileSystemObject")
x = 0
yol = klsr
Application.ScreenUpdating = False
If ds.GetFolder(yol).subfolders.Count = 0 Then GoTo Son
Do
Tekrar:
If ds.GetFolder(yol).subfolders.Count > 0 Then
    For Each kls In ds.GetFolder(yol).subfolders
        klslst = klslst & "{" & kls
    Next
End If
x = x + 1
deg = Split(klslst, "{")
yol = deg(x)
If ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x
Son:
[COLOR="DarkRed"]AllFolderCount[/COLOR] = x
End Function

Sub Alt_Klasör_Sayısı()
Set shl = CreateObject("Shell.Application")
Set hdf = shl.BrowseForFolder(0, "Lütfen bir klasör seçiniz!", 0)
If hdf Is Nothing Then
Exit Sub
Else
yol = hdf.self.Path
End If

MsgBox "Klasör sayısı: " & [COLOR="darkred"]AllFolderCount(yol)[/COLOR]
End Sub