[megaloman]

Если надо в папке сохранить подпапки в её корне, и удалить все файлы и папки в них, в моём решении замените подпрограмму на вот эту

Код:

Sub AllFolders(WDir)
    FSO.DeleteFile WDir + "\*.*", True
    
    Set SubF = FSO.GetFolder(WDir).SubFolders

    For Each Folder In SubF
        FSO.DeleteFile WDir + "\" + Folder.Name + "\*.*", True
        FSO.DeleteFolder WDir + "\" + Folder.Name + "\*.*", True
    Next

End Sub

Но батник всё равно короче и надёжнее:

Код:

@Echo Off
Set Where=C:\Tmp

FOR /F "usebackq delims=" %%i IN (`Dir %Where%\*.* /B /A:D`) DO Call :CleanDir "%%i" 
Del "%Where%\*.*" /S /A:R /A /Q >nul 1>nul
GoTo :Eof

:CleanDir
Cd /D "%Where%\%~1"
rd "%Where%\%~1" /S /Q