DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Listele()
Dim FSO As Object, f As Object
Set FSO = CreateObject( _
"Scripting.FileSystemObject").GetFolder( _
ThisWorkbook.Path).SubFolders
For Each f In FSO
d = Dir(f.Path & "\")
If d <> "" Then
While Not d = ""
i = i + 1
Cells(i + 1, "c") = f.Name
Cells(i + 1, "d") = d
d = Dir
Wend
End If
Next
Set FSO = Nothing
End Sub