利用VBS脚本删除磁盘中的空文件和空文件夹

在日常使用计算机过程中，会产生大量的空文件和空文件夹，利用脚本就可以打他们找出来并删除。

脚本中利用了递归，效率会受到影响。

目前没有完成：1. 输入的盘符没有进行校验，所以输入时需要注意格式。

    2.程序默认是直接删除文件和文件夹，没有发送到回收站。（后期的修改中添加此功能）

代码如下：

'////////////////////////////////////////////////////////////////////'功能:删除本地磁盘中空文件夹和空文件的VBS脚本。'并创建删除日志EmptyDeleteLog.log文件，保存在C盘的根目录下。'作者: Zero'创建时间: 2014/11/6'更新时间: 2015/12/8'版本：0.01 beta'///////////////////////////////////////////////////////////////////'Golbal VariablesDim WshShell, objFSO, logFile, logBookConst ForAppending = 8logFile = "C:\EmptyDeleteLog.log"'日志保存路径Set WshShell =   WScript.CreateObject("Wscript.Shell") 'Shell对象Set objfso   =   WScript.CreateObject("Scripting.FileSystemObject") 'FileSystemObject对象Set logBook  =   objFSO.OpenTextFile(logFile, ForAppending, True)  '以追加方式打来日志文件，True表示当文件不存在时，创建新文件。Call MainSub()'调用主过程'/////////////////////////////////////////////////////////////////'功能：主过程，调用各个子过程和函数。'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'////////////////////////////////////////////////////////////////Sub MainSub()On Error Resume Nextprompt =  "日志文档保存在 " & vbCrLf & logFile & vbCrLf & vbCrLf & "单击是(开始)，否(退出)！" & vbCrLf & vbCrLf &_  "(c) Zero 2015"confirm = MsgBox("本脚本将在本地磁盘上搜索空的东西(文件夹和文件)!"  & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1, "欢迎使用！By Zero")If confirm = vbYes ThenMsgBox "不建议在C盘和D盘使用，错误删除与作者无关" , vbOKOnly +  vbExclamation ,"提示"MainProcess()Else If confirm  = vbNo Then MsgBox "你选择了退出" & vbCrLf & "(c) Zero 2015" , vbOKOnly+ vbError,"提示"  WScript.Quit     End If End IfEnd Sub'////////////////////////////////////////////////////////////////////////////////'功能：分析和处理用户输入的选项，选项1代表搜索文件，选项2代表搜索文件夹，选项3代表退出'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Function MainProcess()On Error Resume Next Dim strChoices,  nResult, getDrv, Ext, logBook, extNamestrChoices =  "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr  & "3.退出"DonResult = InputBox("请输入需要处理的事项:" & vbCr & strChoices, "选项")if IsNumeric(nResult) thenExit DoElseMsgBox "请输入1到3之间的整数", vbYes + vbError, "输入错误"end IfLoopSelect Case CInt(nResult)Case 1: '搜索空文件 ProcessEmptyFile()Case 2: '搜索空文件夹ProcessEmptyFolder()Case 3:'退出WScript.QuitCase Else:'显示错误信息MsgBox "请输入1到3之间的整数", vbYes + vbError, "输入错误"End Select End Function '////////////////////////////////////////////////////////////////////////////////'功能：处理空文件，并检查盘符是否存在。检查结束后，打开日志文件'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Sub ProcessEmptyFile()Do getDrv = InputBox("请输入需要处理的盘符"& "格式如下:E","盘符","E")getDrv = getDrv & ":\" '格式盘符If  objFSO.DriveExists(getDrv) Then Exit Do Else MsgBox "你输入的盘符不存在", vbOKOnly + vbExclamation, "错误"End If Loop   extName = InputBox("请输入需要搜索的文件扩展名"& "比如：txt","扩展名","txt")  WshShell.Popup "现在开始检查文件", 2  Call CheckDiskFile(getDrv,extName)'调用CheckDiskFile函数遍历和检查文件OpenLogFile()'结束后，打开日志文件WScript.Quit'退出End Sub  Sub ProcessEmptyFolder()DogetDrv = InputBox("请输入需要处理的盘符"& "格式如下:E","盘符","E")getDrv = getDrv & ":\"If  objFSO.DriveExists(getDrv) Then Exit Do Else MsgBox "你输入的盘符不存在", vbOKOnly + vbExclamation, "错误"End If LoopSet drive = objfso.GetDrive(getDrv)WshShell.Popup "现在开始检查文件夹", 2CheckFolder(drive.RootFolder)OpenLogFile()End Sub '////////////////////////////////////////////////////////////////////////////////'功能：检查文件是否为空'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Sub IsEmptyFile(file,ext)    On  Error Resume Next extName = objFSO.GetExtensionName(file)'得到文件的扩展名fileContent = objFSO.GetFile().OpenAsTextStream().ReadAll()'得到文件的内容'如果文件的大小为零或文件的内容为空就删除文件If (file.Size = 0 And extName = ext) Or (extName = ext And fileContent = "")  Then          ReportEmptyFile(file)End IfEnd Sub '////////////////////////////////////////////////////////////////////////////////'功能：删除文件，并将空文件的删除信息写入日志文件'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Function  ReportEmptyFile(file)    On Error Resume Next    response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_ "你想删除吗？", vbYesNoCancel + vbDefaultButton1,"提示")If vbYes = response ThenlogBook.WriteLine logBook.WriteLine "[文件:]"logBook.WriteLine "文件名称:" & file.NamelogBook.WriteLine "文件路径: " & file.PathlogBook.WriteLine "文件创建时间: " & file.DateCreatedlogBook.WriteLine "文件最后修改时间: " & file.DateLastModifiedlogBook.WriteLine  "-----------------------------------------------"logBook.WriteLine "在 " & Now & " 被删除"logBook.Close()objFSO.DeleteFile file, True '删除文件Else If vbCancel = response Then '单击取消就打开日志文件OpenLogFile()End If   End If End Function'/// /////////////////////////////////////////////检查空文件部分结束//////////////////////// '////////////////////////////////////////////////////////////////////////////////'功能：遍历并检查文件夹下的子文件夹是否为空（其中用到了递归）'参数：objFolder'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Function CheckFolder(objFolder)On Error Resume Next IsEmptyFolder(objFolder)for each subfolder in objFolder.subfoldersCheckFolder subfolder'递归检查子文件夹NextEnd  FunctionFunction IsEmptyFolder(objFolder)On Error Resume Next if objFolder.Size=0 and err.Number=0 Then'文件夹的大小为零if objFolder.subfolders.Count=0 Then'文件夹下没有子文件夹ReportEmptyFolder objFolderEnd  IfEnd  IfEnd  Function'////////////////////////////////////////////////////////////////////////////////'功能：删除文件夹，将空文件夹的删除信息写入日志文件'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'///////////////////////////////////////////////////////////////////////////////Sub ReportEmptyFolder(objFolder)On Error Resume Next response = MsgBox("我们在:" & vbCr _& objFolder.path & vbCr & "发现了空文件夹 " _& "你想删除这个文件夹么?", _vbYesNoCancel + vbDefaultButton2)If response = vbYes ThenlogBook.WriteLine logBook.WriteLine "[文件夹:]"logBook.WriteLine "文件夹名称:" & objFolder.NamelogBook.WriteLine "文件夹路径: " & objFolder.PathlogBook.WriteLine "文件夹创建时间: " & objFolder.DateCreatedlogBook.WriteLine "文件夹最后修改时间: " & objFolder.DateLastModifiedlogBook.WriteLine  "-----------------------------------------------"logBook.WriteLine "在 " & Now & " 被删除"logBook.Close()objFSO.DeleteFolder objFolder, True '删除文件夹Else If response= vbCancel ThenOpenLogFile()End IfEnd If end Sub'/////////////////////////////////////////////////////////////////'功能:遍历特定磁盘的包含ext扩展名的文件和文件夹（利用递归）'作者: Zero'创建时间: 2014/11/6'更新时间: 2015/12/8'////////////////////////////////////////////////////////////////Function CheckDiskFile(drv,ext)On Error Resume NextDim colFiles, File, extTemp, subFolderTemp, colSubFoldersextTemp = ext   Set drvRootFiles = objFSO.GetFolder(drv)   Set colFiles = drvRootFiles.Files      For Each File In colFiles   IsEmptyFile File,extTemp Next  Set subFolderTemp = fso.GetFolder(drv)  Set colSubFolders = subFolderTemp.SubFolders  For Each subfolder In colSubFolders   CheckDiskFile subfolder,extTemp '递归  Next  End Function'/////////////////////////////////////////////////////////////////'功能: 打开日志文件'参数：无'创建时间: 2014/11/6'更新时间: 2015/12/8'////////////////////////////////////////////////////////////////Function OpenLogFile()MsgBox "谢谢使用！现在打开日志文件！" & vbCrLf & "(c) Zero 2015"WshShell.Run logFileEnd Function 

程序界面：