利用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 
程序界面:



  • 2
    点赞
  • 3
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值