Dosyada bulunan klasör isimlerini listeleme hakkında

[yesimgurol]

Merhabalar,
Bir dosya (klasör) içerisindeki klasör isimlerini listelemek ve listelenen klasörlerin içinde arama yaptırmak istemekteyim.
Amacım bir arşiv dosyası içinde hasta klasörlerim mevcut,bu klasör isimlerinin içinde aramak yaptırmak ve bulunan klasöre tıkladığımda o klasör içeriğine gitmek istiyorum.
Daha öncede bir kaç örnek başka bir çalışma için kullanmıştık saolsun buradaki arkadaşlar yardımcı olmuşlardı. Listbox ve listviev kullanmıştık.
Bu klasörleri listelemek ve arama yaptırmak için listview mi yoksa listbox mu kullanmak daha yararlı olur?:dusun:

 

[yesimgurol]

Örneklerden bakarak listview oluşturmaya çalıştım.Kodları;

Private Sub UserForm_Initialize()
Dim i As Integer
ListView1.View = lvwReport
With ListView1.ColumnHeaders
    .Add , , "SIRA NO ", 50
    .Add , , "ADI SOYADI  ", 80

           
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
End Sub

Yalnız , "C:\Users\yesım\Desktop\DENEME" klasörünün içindeki klasörleri listeleyemedim:-( :dusun:

 

[halit3]

Farklı yaklaşım ile bu kod klasör ve dosyaları listeliyor.

Sub klasor_listele()

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
Cells.ClearContents
Liste1 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Application.DisplayAlerts = True

Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If


End Sub
Private Sub Liste1(yol As String)

'On Error Resume Next

Dim fL As Object, f As Object, Dosya As Object, j As Long
Set fL = CreateObject("Scripting.FileSystemObject")
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
Cells(j, 1) = yol
Cells(j, 1).Select

i = 3

Cells(j, 2).Value = fL.GetFolder(yol).Files.Count
son1 = fL.GetFolder(yol).Files.Count
son2 = Columns.Count
For Each Dosya In fL.GetFolder(yol).Files
Cells(j, i).Value = Dosya.Name
i = i + 1

If i = Columns.Count Then

Cells(j, 2).Value = Columns.Count - 2
If son2 + Columns.Count >= son1 Then

Cells(j + 1, 2).Value = (son2 - son1) - ((son2 - son1) * 2) + 2
End If

son2 = son2 + Columns.Count - 2
i = 3
j = j + 1
Cells(j, 1) = yol
Cells(j, 1).Select
End If
Next



On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
On Error Resume Next
Liste1 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[halit3]

Bu kod da klasör adresi belli olan için

Sub klasor_listele2()


Kaynak = "C:\Users\yesım\Desktop\DENEME"

Cells.ClearContents
Liste1 (Kaynak)


End Sub
Private Sub Liste1(yol As String)


Dim fL As Object, f As Object, Dosya As Object, j As Long
Set fL = CreateObject("Scripting.FileSystemObject")
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
Cells(j, 1) = yol
Cells(j, 1).Select

i = 3

Cells(j, 2).Value = fL.GetFolder(yol).Files.Count
son1 = fL.GetFolder(yol).Files.Count
son2 = Columns.Count
For Each Dosya In fL.GetFolder(yol).Files
Cells(j, i).Value = Dosya.Name
i = i + 1

If i = Columns.Count Then

Cells(j, 2).Value = Columns.Count - 2
If son2 + Columns.Count >= son1 Then

Cells(j + 1, 2).Value = (son2 - son1) - ((son2 - son1) * 2) + 2
End If

son2 = son2 + Columns.Count - 2
i = 3
j = j + 1
Cells(j, 1) = yol
Cells(j, 1).Select
End If
Next



On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
On Error Resume Next
Liste1 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[yesimgurol]

Halit Bey,ilginize teşekkür ederim.Yalnız çok fazla kapsamlı sanki kodlar konusunda çok bilgim yok:-(
Amacım hatta sizin oluşturduğunuz kodlar hastalarım için klasör açıyordu ben bu klasörleri listeleyip bunlar içinde hasta adına göre arama yaptırmak istemiştim.Dosyalarım hepside bir klasör içinde olacak.

 

[PLİNT]

Merhaba
Alternatif olarak "Listview" de listelemek içinde şöyle deneyiniz:

 Private Sub UserForm_Initialize()
Dim i As Integer
ListView1.View = lvwReport
With ListView1.ColumnHeaders
    .Add , , "SIRA NO ", 50
    .Add , , "ADI SOYADI  ", 80
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\Users\yesım\Desktop\DENEME")
For Each a In f.subfolders
x = x + 1
ListView1.ListItems.Add , , x
ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , a.Name
Next
End Sub

Listeden seçip klasörü açmak içinde:

Private Sub ListView1_Click()

aç = Shell("C:\WINDOWS\Explorer.exe C:\Users\yesım\Desktop\[COLOR="Red"]DENEME\"[/COLOR] & ListView1.SelectedItem.ListSubItems(1).Text, vbNormalFocus)

End Sub

 

[yesimgurol]

Sayın PLINT,çok teşekkür ederim.Evet klasör isimleri listelendi istediğim gibi,yalnız son verdiğiniz listedeki klasör ismine tıkladığımda belgelerim klasörü açılıyor hep:-(
Yada şöyle bir şey yapabilirmiyiz ben listview üzerine textbox eklemesi yapmaya çalışıyorum şu anda listeleme çok güzel oldu acaba ben textbox1 e yazdığımı listview dekilerin içinde filtrelese ve ona tıkladığımda klasör açılsa olur mu ki?

 

[PLİNT]

Merhaba
Yukarıdaki aç kodunda "\" işareti eksik olmuş değişen şekilde kullanınız,
Textbox içinde aşağıdaki gibi olabilir:
(Yukarıdaki "Private Sub UserForm_Initialize()") kodları aynen kullanarak)

Private Sub TextBox1_Change()
ListView1.ListItems.Clear
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\Users\yesım\Desktop\DENEME")
For Each a In f.subfolders
If LCase(a.Name) Like LCase(TextBox1 & "*") Then
x = x + 1
ListView1.ListItems.Add , , x
ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , a.Name
End If
Next
End Sub

 

[yesimgurol]

Sayın PLİNT,çok çok teşekkür ederim.Elinize sağlık.:bravo::dua2::mutlu::mutlu: Çok güzel oldu sayenizde,gerçekten çok sağolun.

 

[PLİNT]

Sayın PLİNT,çok çok teşekkür ederim.Elinize sağlık.:bravo::dua2::mutlu::mutlu: Çok güzel oldu sayenizde,gerçekten çok sağolun.

Sizde sağolun, kolay gelsin.