DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub CommandButton1_Click()
[COLOR="Blue"]Cells = ""[/COLOR]
On Error Resume Next
Set a = CreateObject("scripting.filesystemobject")
[COLOR="Blue"][a1] = "C:\Deneme"[/COLOR]
s = 1
n = 1: h = 1
geri: i = 0: s = s + 1
For j = 1 To Cells(Rows.Count, h).End(3).Row
k = Cells(j, h).Value
Set klasor = a.GetFolder(k)
If Not klasor Is Nothing Then
If klasor.Subfolders.Count > 0 Then
For Each alt In klasor.Subfolders
i = i + 1
Cells(i, s) = alt
Next
End If
End If
Next
h = h + 1: n = n + 1
If Cells(1, h) <> "" Then: Set klasor = Nothing: GoTo geri
End Sub