D: sürücüsü içeriğini listeleme

[aydogankemal]

Merhabalar,
Paylaşımı yapmadan önce "Klasör Listeleme" olarak arattım ki kimseyimeşgul etmeyeyim. Ancak bir çok talepte belirli bir klasör içeriğini listelemek ile ilgili kodlar vardı.
Benim istediğim: D sürücüsü klasör listesini alıp data isimli sayfaya listelemesi. Bunu yaparken herhangi bir klasör seç işlemi olmadan, dosya açılırken yapması.
Şimdiden yardımlarınız için teşekkür ederim

 

[aydogankemal]

Arşivde aşağıdaki şekilde bir kod buldum ancak 2. if komutunda hata veriyor, nasıl düzeltebilirim,

Sub Klasör_Listele() 'Tüm alt klasörleri listeler
Set ds = CreateObject("Scripting.FileSystemObject")
yol = "D:\"
Columns(1).Clear
Application.ScreenUpdating = False
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)
Cells(x, 1) = deg(x)
If x = 1 And ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar

Loop While UBound(deg) <> x

'Kodlayan: l e u m r u k - mustafa altun
End Sub

 

[Necdet]

Merhaba,

Kendim için düzenlediğim dosyayı ekliyorum, siz kendinize göre kodları uyarlayınız.

 

[aydogankemal]

Merhaba,

Kendim için düzenlediğim dosyayı ekliyorum, siz kendinize göre kodları uyarlayınız.

Teşekkür ederim, sadece 1 sorum olacak,
Sizin dosyanızı aşağıdaki gibi nasıl değiştirebiliriz,
Başlangıç dizinini sormadan D:\
Dosya/Dizin seçeneği Dizin(klasör)
Alt Dizin Hayır
Dosya Uzantısı boş

 

[Necdet]

Merhaba,

İlk Sub aşağıdaki gibi değiştirildi, diğer kodlara dokunmayın.

Sub FSO_Basla()

                                'Microsoft Scripting Runtime Yüklü Olmalı
                                'Aşağıdaki İşlem Erken Bağlama
                                ' https://www.youtube.com/watch?v=hT2ufvY9b6w&list=WL&index=140


'DizinBul


'Dim BsKlasor As Scripting.Folder
'Dim BsDizinAdi As String
'
Set fso = New Scripting.FileSystemObject
'BsDizinAdi = Range("B1")
'DosyaDizin = Range("B2")
'
'Set BsKlasor = fso.GetFolder(BsDizinAdi)
'
'If fso.FolderExists(BsDizinAdi) = False Then fso.CreateFolder DizinAdi

'Debug.Print bitisKlasor.DateCreated

'If Range("B1") = "" Then Exit Sub    'Dosya/Dizin

'If Range("B3") = "Evet" Then
'    AltDizinler = True
'Else
    AltDizinler = False
'End If

'Uzanti = Replace(Range("B4"), ".", "")

'If Uzanti = "" Then
'    Uzanti = "*"
'Else
'    Uzanti = Left(Uzanti, 2) & "*"
'End If

i = 2
Range("D2").CurrentRegion.Offset(1).ClearContents

Listele_Dosya_Dizin "C:\"

'Columns("D:E").AutoFit

End Sub

 

[Korhan Ayhan]

Alternatif olarak forumun arşivinde bulunsun...