DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Bos_Klasor_Sil()
'Excel.web.tr/anemos
'=================================================================================================='II
'IIIIIIIIII Seçilen klasörün içerisindeki boş klasörleri siler. 'IIIIIIIIII'II
'=================================================================================================='II
1 Dim klasor, fL, f As Object, yol$
2 Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
3 If klasor Is Nothing Then Exit Sub
[COLOR=red][B]4 yol = klasor.Items.Item.Path[/B][/COLOR]
5 DoEvents
6 Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
7 On Error Resume Next
8 For Each f In fL
9 If Dir(f.Path) = "" Then RmDir f.Path
10 yol = f.Path
11 GoTo 5
12 Next
13 On Error GoTo 0
14 Set fL = Nothing: Set f = Nothing: Set klasor = Nothing: yol = ""
End Sub
yol=CreateObject("Wscript.Shell").SpecialFolders("Desktop")
Sub Bos_Klasor_Sil()
Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
If klasor Is Nothing Then Exit Sub
yol = klasor.self.Path
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
For Each f In fL
If f.Files.Count = 0 And f.subfolders.Count = 0 Then RmDir f.Path
Next
Set fL = Nothing: Set f = Nothing: Set klasor = Nothing: yol = ""
End Sub