Klasör Altındaki Klasörleri Listeleme

[askm]

Kolay gelsin.
Belli bir klasörün altındaki klasör isimlerini listelemek istiyorum. Yalnız örneğin A klasörü varsa listeye almayacak. Ve Alt klasörlere girmeyecek.

 

[PLİNT]

Merhaba
Aşağıdaki gibi işinize yarayabilir; boş bir sayfada deneyin.

[SIZE="2"]Private Sub CommandButton1_Click()
Set a = CreateObject("scripting.filesystemobject")
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbBinaryCompare
n = 1
dic.Add n, "E:\DENEME\"
geri:
h = dic.Count
For j = n To h
If a.GetFolder(dic(j)).Name <> [COLOR="Red"]"A"[/COLOR] Then
Set klasor = a.GetFolder(dic(j))
 If klasor.Subfolders.Count > 0 Then
For Each alt In klasor.Subfolders
If alt.Name <> [COLOR="Red"]"A"[/COLOR] Then dic.Add dic.Count + 1, alt
Next: End If:
 End If: Next
If h < dic.Count Then
n = h + 1: Set klasor = Nothing:
GoTo geri: End If
Cells(1, 2).Resize(dic.Count) = Application.Transpose(dic.Items)
End Sub [/SIZE]

 

[GursoyC]

Sayın Plint merhaba,

listelenmesini istediğimiz klasörün path'ini A1 hücresine girerek listelemek istesek aynı kodları nasıl değiştirmemiz gerekir acaba?

 

[PLİNT]

Sayın Plint merhaba,

listelenmesini istediğimiz klasörün path'ini A1 hücresine girerek listelemek istesek aynı kodları nasıl değiştirmemiz gerekir acaba?

Merhaba
Yukarıdaki kodlarda aşağıdaki değişiklik yeterli olacaktır,
Ek te iki çeşit örnek bulunuyor
http://s3.dosya.tc/server11/vmz84w/KLASOR_LISTE.zip.html

Private Sub CommandButton1_Click()
Set a = CreateObject("scripting.filesystemobject")
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbBinaryCompare
n = 1
dic.Add n[COLOR="Red"], [A1].Value[/COLOR]
'....
'... diğer kodlar

 

[GursoyC]

Çok teşekkürler.

 

[askm]

Sayın Plint Kodlar için teşekkürler.
C:\ içinde arama yapınca If klasor.Subfolders.Count > 0 Then kısmında hata verdi. Benim asıl yapmak istediğim C: Kullanıcılar klasöründeki oturum açan son 2 kullanıcıyı bulmak. Bu listeyi tarih sıralı alma imkanı olur mu?

 

[PLİNT]

Merhaba
Bahsettiğiniz hata erişim engellenen klasör bulunduğundandır.
Aşağıdaki gibi işinize yararmı?

 [SIZE="2"] Private Sub CommandButton1_Click()
Set a = CreateObject("scripting.filesystemobject")
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbBinaryCompare
n = 1: v = v + 1
dic.Add n, [COLOR="Red"]"C:\Documents and Settings\"[/COLOR]
geri:
h = dic.Count
[COLOR="Red"]On Error Resume Next[/COLOR]
For j = n To h
If a.GetFolder(dic(j)).Name [COLOR="Red"]<> "A"[/COLOR] Then
Set klasor = a.GetFolder(dic(j))
 If klasor.Subfolders.Count > 0 Then
For Each alt In klasor.Subfolders
If alt.Name [COLOR="Red"]<> "A" [/COLOR]Then
v = v + 1
Cells(v, "A") = alt.DateLastModified
Cells(v, "B") = alt
dic.Add dic.Count + 1, alt
End If
Next:
End If
 End If: Next
If h < dic.Count Then
n = h + 1: Set klasor = Nothing:
GoTo geri: End If
[COLOR="Red"]a = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:B" & a).Sort Key1:=Cells(1, 1), Order1:=xlDescending[/COLOR]
End Sub[/SIZE]

 

[askm]

İlginiz, bilginiz için çok teşekkür ederim. Allah razı olsun.