DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Listele()
Dim DTipi$, Klasor$
Klasor = InputBox("Listelenecek Klasörü yazınız", "Klasör nerde ?")
If Klasor = "" Then End
DTipi = InputBox("Listelenecek dosya türünü yazınız", "Dosya türü ne?", "*.*")
Call ListeAl(Klasor, DTipi, True)
End
End Sub
Sub Cmm()
On Error Resume Next
Dim DTipi$, Klasor$
Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
Klasor = objFolder.Items.Item.Path
DTipi = InputBox("Listelenecek dosya türünü yazınız", "Dosya türü ne?", "*.*")
Call ListeAl(Klasor, DTipi, True)
End Sub
Sub ListeAl(Klasor$, DTipi$, Alt%)
Dim klasorler(), i, dosya$, yol$, attr%, ks%
[c3].Select
Static r
'On Error Resume Next
If Right$(Klasor, 1) <> "\" Then Klasor = Klasor & "\"
If DTipi = "" Then End
dosya = Dir(Klasor & DTipi, vbNormal)
Do While dosya <> ""
ActiveCell.Offset(r, 0) = Klasor
ActiveCell.Offset(r, 1) = dosya
r = r + 1
dosya = Dir()
Loop
If Alt = False Then Exit Sub
dosya = Dir(Klasor & "*.*", vbDirectory)
Do While dosya <> ""
attr = 0
attr = GetAttr(Klasor & dosya)
If dosya <> "." And dosya <> ".." And _
(attr And vbDirectory) <> 0 _
Then
ks = ks + 1 'klasör sayısı
ReDim Preserve klasorler(1 To ks)
klasorler(ks) = dosya
End If
dosya = Dir()
Loop
For i = 1 To ks
Call ListeAl(Klasor & klasorler(i) & "\", DTipi, Alt)
Next i
'r = vbNullString
End Sub