利用VBS脚本删除磁盘中的空文件和空文件夹
在日常使用计算机过程中，会产生大量的空文件和空文件夹，利用脚本就可以打他们找出来并删除。
脚本中利用了递归，效率会受到影响。
目前没有完成：1. 输入的盘符没有进行校验，所以输入时需要注意格式。
2.程序默认是直接删除文件和文件夹，没有发送到回收站。（后期的修改中添加此功能）
代码如下：
'
'功能:删除本地磁盘中空文件夹和空文件的VBS脚本。
'并创建删除日志EmptyDeleteLog.log文件，保存在C盘的根目录下。
'作者: Zero
'创建时间: 2014/11/6
'更新时间: 2015/12/8
'版本：0.01 beta
'///
'Golbal Variables
Dim WshShell, objFSO, logFile, logBook
Const ForAppending = 8
logFile = "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 Next
prompt = "日志文档保存在 " & vbCrLf & logFile & vbCrLf & vbCrLf & "单击是(开始)，否(退出)！" & vbCrLf & vbCrLf &_
"(c) Zero 2015"
confirm = MsgBox("本脚本将在本地磁盘上搜索空的东西(文件夹和文件)!" & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1, "欢迎使用！By Zero")
If confirm = vbYes Then
MsgBox "不建议在C盘和D盘使用，错误删除与作者无关" , vbOKOnly + vbExclamation ,"提示"
MainProcess()
Else If confirm = vbNo Then
MsgBox "你选择了退出" & vbCrLf & "(c) Zero 2015" , vbOKOnly+ vbError,"提示"
WScript.Quit
End If
End If
End Sub
'
'功能：分析和处理用户输入的选项，选项1代表搜索文件，选项2代表搜索文件夹，选项3代表退出
'参数：无
'创建时间: 2014/11/6
'更新时间: 2015/12/8
'///
Function MainProcess()
On Error Resume Next
Dim strChoices, nResult, getDrv, Ext, logBook, extName
strChoices = "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr & "3.退出"
Do
nResult = InputBox("请输入需要处理的事项:" & vbCr & strChoices, "选项")
if IsNumeric(nResult) then
Exit Do
Else
MsgBox "请输入1到3之间的整数", vbYes + vbError, "输入错误"
end If
Loop
Select Case CInt(nResult)
Case 1: '搜索空文件
ProcessEmptyFile()
Case 2: '搜索空文件夹
ProcessEmptyFolder()
Case 3: '退出
WScript.Quit
Case 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()
Do
getDrv = InputBox("请输入需要处理的盘符"& "格式如下:E","盘符","E")
getDrv = getDrv & ":\"
If objFSO.DriveExists(getDrv) Then
Exit Do
Else
MsgBox "你输入的盘符不存在", vbOKOnly + vbExclamation, "错误"
End If
Loop
Set drive = objfso.GetDrive(getDrv)
WshShell.Popup "现在开始检查文件夹", 2
CheckFolder(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 If
End Sub
'
'功能：删除文件，并将空文件的删除信息写入日志文件
'参数：无
'创建时间: 2014/11/6
'更新时间: 2015/12/8
'///
Function ReportEmptyFile(file)
On Error Resume Next
response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_
"你想删除吗？", vbYesNoCancel + vbDefaultButton1,"提示")
If vbYes = response Then
logBook.WriteLine
logBook.WriteLine "[文件:]"
logBook.WriteLine "文件名称:" & file.Name
logBook.WriteLine "文件路径: " & file.Path
logBook.WriteLine "文件创建时间: " & file.DateCreated
logBook.WriteLine "文件最后修改时间: " & file.DateLastModified
logBook.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.subfolders
CheckFolder subfolder '递归检查子文件夹
Next
End Function
Function IsEmptyFolder(objFolder)
On Error Resume Next
if objFolder.Size=0 and err.Number=0 Then '文件夹的大小为零
if objFolder.subfolders.Count=0 Then '文件夹下没有子文件夹
ReportEmptyFolder objFolder
End If
End If
End 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 Then
logBook.WriteLine
logBook.WriteLine "[文件夹:]"
logBook.WriteLine "文件夹名称:" & objFolder.Name
logBook.WriteLine "文件夹路径: " & objFolder.Path
logBook.WriteLine "文件夹创建时间: " & objFolder.DateCreated
logBook.WriteLine "文件夹最后修改时间: " & objFolder.DateLastModified
logBook.WriteLine "-----------------------------------------------"
logBook.WriteLine "在 " & Now & " 被删除"
logBook.Close()
objFSO.DeleteFolder objFolder, True '删除文件夹
Else If response= vbCancel Then
OpenLogFile()
End If
End If
end Sub
'/
'功能:遍历特定磁盘的包含ext扩展名的文件和文件夹（利用递归）
'作者: Zero
'创建时间: 2014/11/6
'更新时间: 2015/12/8
'
Function CheckDiskFile(drv,ext)
On Error Resume Next
Dim colFiles, File, extTemp, subFolderTemp, colSubFolders
extTemp = 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 logFile
End Function 