Чистим папку в ОС Виста

[EducatedFool]

после перезагрузки сразу виден прирост скорости

Истинный прирост скорости ты сможешь наблюдать только после форматирования диска и установки WinXP

при удалении папки "winsxs(7 гб)" уже в папке "C:\Temp".

А как эти файлы оказались в папке Temp ?
Может, тогда проще было макросом не удалять их, а перемещать в эту папку...
Ну да ладно, теперь уже поздно.

[valerij]

Сообщение от EducatedFool

Ну да ладно, теперь уже поздно.

EducatedFool!
Еще такой вопрос, как сделать, если папка пуста, то удалить, много в папке "winsxs" осталось пустых папок, экспериментировать, так до конца!!

[EducatedFool]

если папка пуста, то удалить

Option Compare Text

Sub test()
    ' удаляет все файлы из всех подпапок в указанном каталоге
    ' остаются только пустые папки
    Delete_All_Files "C:\Documents and Settings\Администратор\Рабочий стол\Копия Копия Копия папка"
End Sub


Function Delete_All_Files(ByVal FolderPath As String)
    On Error Resume Next
    'Dim fso As FileSystemObject, curfold As Folder, fil As File, sfol As Folder
    Set fso = CreateObject("scripting.filesystemobject")
    Set curfold = fso.GetFolder(FolderPath)

    Application.StatusBar = "Обрабатывается папка  " & FolderPath

    If Not curfold Is Nothing Then
        For Each fil In curfold.Files
            Select Case True
                Case fil.Name Like "*.exe*"    ' не удаляем файлы, у которых имя соответствует этой маске
                Case fil.Name Like "*.xla*"    ' не удаляем файлы, у которых имя соответствует этой маске
                Case fil.Name Like "*.txt*"    ' не удаляем файлы, у которых имя соответствует этой маске
                Case Else: fil.Delete True    ' а все остальные удаляем
            End Select
        Next
        For Each sfol In curfold.SubFolders
            Delete_All_Files sfol.Path    ' удаляем файлы во всех подпапках этой папки
        Next
        
        ' curfold.Delete ' эта команда удалит папку независимо от наличия в ней файлов
        
        ' а эта команда удалит только пустые папки (не содержащие ни файлов, ни подпапок)
        If curfold.Files.Count = 0 And curfold.SubFolders.Count = 0 Then curfold.Delete True
        
        Set fil = Nothing: Set curfold = Nothing: Set fso = Nothing:
    End If
End Function

Или, если файлы удалять не требуется, можно упростить код:

Option Compare Text

Sub test2()
    ' удаляет только пустые папки (не содержащие ни файлов, ни подпапок)
    Delete_Empty_Folders "C:\Documents and Settings\Администратор\Рабочий стол\имя папки"
End Sub


Function Delete_Empty_Folders(ByVal FolderPath As String)
    On Error Resume Next
    Set fso = CreateObject("scripting.filesystemobject"): Set curfold = fso.GetFolder(FolderPath)

    If Not curfold Is Nothing Then
        For Each sfol In curfold.SubFolders: Delete_Empty_Folders sfol.Path: Next
        ' эта команда удалит только пустые папки (не содержащие ни файлов, ни подпапок)
        If curfold.Files.Count = 0 And curfold.SubFolders.Count = 0 Then curfold.Delete True
        Set curfold = Nothing: Set fso = Nothing:
    End If
End Function

[valerij]

EducatedFool!
И последний штрих!
Перед генеральным тестированием(переставлю образ), можно сделать, что бы макрос подсчитал:
test()(последний) - сколько папок было до удаления и сколько шт. удалено

[valerij]

EducatedFool!
Может и не надо подсчитывать - сколько папок было до удаления и сколько шт. удалено, это в принципе, мона глянуть и в свойствах, а вот как то контроль выполнения, желателен, может время выполнения????
Кстати, больше в C:\Temp, папка не появлялась, то видимо в процессе настройки.
И еще, под одну клавишу F1, запуск....
В аттаче

З. Ы.
Раз 10 переставлял разные образы висты(Хом, Ультим....32/64), все супер работает, резко поднимается скорость, несмотря на антивирусник

[EducatedFool]

контроль выполнения, желателен

Пожалуйста...


Забыл убрать кое-что.

В функции Delete_All_Files замени строку For i = 1 To 300: DoEvents: Next на строку DoEvents
(или вообще убери её. Это была пауза для визуального контроля отображения имён файлов)

Ну, и в строке FolderPath = "C:\Windows\temp" замени "C:\Windows\temp" на '"C:\Windows\winsxs"

Кстати, за одним почистил себе папку Temp... Хоть какая-то польза (раньше делал это вручную)

[valerij]

Сообщение от EducatedFool

Хоть какая-то польза (раньше делал это вручную)

+1
EducatedFool
А что и для чего, это?

Sub testCropPath()
    MsgBox CropPath("C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE")
End Sub

[EducatedFool]

Случайно попал ненужный для этого файла кусок кода.
Не обращай внимания - там есть неиспользуемые функции.

запустил бы этот код, да увидел.
функция CropPath из полного пути вырезает только имя файла.

Запускай только макрос test.
А лучше и его не запускай

[valerij]

Сообщение от EducatedFool

замени "C:\Windows\temp" на '"C:\Windows\winsxs"

Как только меняю, ошибка Overflow (Error 6) и : StartSize = curfold.Size: желтым

[EducatedFool]

Как только меняю, ошибка Overflow

Размер папки (в байтах) не умещается в переменную типа Long
(максимальное значение которой 2,147,483,647)

Попробуй заменить строку
Dim pi As ProgressIndicator, StartSize As Long, CurrentSize As Long

на строку Dim pi As ProgressIndicator, StartSize As Single, CurrentSize As Single


Хотя можно было бы и по-другому:
заменить StartSize = curfold.Size и s = fil.Size
на StartSize = curfold.Size / 100 и s = fil.Size / 100
Но ты ведь умудришься найти папку размером более 200 Гб

Поэтому просто замени Long на Single