Код:

Option Explicit

Dim oFSO, oFolder, oSubFolders
'Путь к корневой папке, в которой ищем все папки нулевого размера
Const strRootFolder = "C:\TEst"

Set oFSO = CreateObject("Scripting.FileSystemObject")

'Если корневая папка существует, создаем ее объект. 
'Иначе выход.
If oFSO.FolderExists(strRootFolder) Then
  Set oFolder = oFSO.GetFolder(strRootFolder)
Else
  WScript.Echo "Incorrect root folder path"
  Set oFSO = Nothing
  WScript.Quit(1)
End If

'Вызываем процедуру удаления пустых папок
Call RemoveEmptyFolders(oFolder)

Set oFolder = Nothing
Set oFSO = Nothing

'Рекурсивная процедура удаления пустых папок
'oRootFolder - текущая папка
sub RemoveEmptyFolders(byref oRootFolder)
  Dim oFolder, oSubFolders
  Set oSubFolders = oRootFolder.SubFolders
  
  for each oFolder in oSubFolders
        RemoveEmptyFolders(oFolder)
        If oFolder.Size = 0 Then
          Call oFSO.DeleteFolder(oFolder.Path, True)
        End If
  next  

  Set oSubFolders = nothing
  Set oFolder = Nothing
end sub