VBS找出本地磁盘中空的东西并删除它们

ZeroX

你是不是在磁盘中建立了很多空的文件或文件夹？
你是不是在搜索它们并删除而在发愁？

有了以下这个小程序就可以帮助你解决！

请将以下代码用记事本保存为SearchAndDelete.vbs 文件！ 请（不）注（要）意（说）扩（不）展（会）名哦！

1. '//////////////////////////////
   
2. 'Description:这是一个能够删除本地磁盘中空文件夹和空文件的小程序！
   
3. 'Author: Zero
   
4. '时间: 2014/11/6
   
5. '/////////////////////////////
   
6. 
   
7. '/// 主程序部分
   
8. Dim objfso, WshShell, ext
   
9. Set objfso = WScript.CreateObject("Scripting.Filesystemobject")
   
10. Set WshShell = CreateObject("Wscript.Shell")
    
11. 
    
12. choices =  "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr  & "3.退出"
    
13. prompt =  "日志文档保存在 " & "C:\EmptyDelete.log" & vbCrLf & vbCrLf & "单击是(开始)，否(退出)！" & vbCrLf & vbCrLf &_
    
14.                   "(c) Zero 2014"
    
15. 
    
16. 
    
17. confirm = MsgBox("本小工具将在本地磁盘上搜索空的东西(文件夹和文件)!"  & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1,"欢迎使用！")
    
18. If confirm = vbyes Then
    
19. 
    
20.         MsgBox "不建议在C盘和D盘使用，错误删除与本作者无关" , vbOKOnly +  vbExclamation ,"提示"
    
21. 
    
22.                 
    
23.        
    
24.        
    
25.        
    
26.         do
    
27.         getchoice = InputBox ("请输入需要处理的事项:" & vbCr & choices)
    
28.        
    
29.         if isnumeric(getchoice) then
    
30.                 exit do
    
31.         else
    
32.                 msgbox "请输入数字"
    
33.         end If
    
34.        
    
35.         Loop
    
36.        
    
37.         getchoice = CInt(getchoice)
    
38.        
    
39.         Select Case getchoice
    
40.        
    
41.         Case 1: '搜索空文件
    
42.        
    
43.                 getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E:","盘符","E")
    
44.                 getdrv = getdrv & ":"
    
45.                   ext = InputBox("请输入需要搜索的文件扩展名"& "比如：txt","扩展名","txt")
    
46.                  
    
47.                 logfile = "C:\EmptyDelete.log"
    
48.                
    
49.                 set logbook = objfso.OpenTextFile(logfile, 8, true)
    
50. 
    
51.                 Call CheckDiskFile(getdrv,ext)
    
52.        
    
53.                 logbook.Close
    
54.                
    
55.                 WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
    
56.                
    
57.         Case 2: '搜索空文件夹
    
58.        
    
59.         getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E","盘符","E")
    
60.         getdrv = getdrv & ":"
    
61.         logfile = "C:\EmptyDelete.log"
    
62.         set logbook = objfso.OpenTextFile(logfile, 8, true)
    
63. 
    
64.         set drive = objfso.GetDrive(getdrv)
    
65. 
    
66.         CheckFolder drive.RootFolder
    
67.        
    
68.         logbook.Close
    
69. 
    
70.                 WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
    
71.                
    
72.                
    
73.        
    
74.         End select
    
75. 
    
76.        
    
77.                
    
78. 
    
79.      Else If confirm  = vbno Then
    
80.                 MsgBox "你会回来的！" & vbCrLf & "(c) Zero 2014" , vbOKOnly+ vbError,"提示"
    
81.                
    
82.                 WScript.Quit
    
83.        
    
84.                 End If
    
85.        
    
86.         End If
    
87.        
    
88.        
    
89. '/// 主程序部分结束
    
90. 
    
91. '/// /////////////////////////////////////////////检查空文件部分开始////////////////////////
    
92.          
    
93. Function CheckDiskFile(drv,ext)
    
94.         extTemp = ext
    
95. 
    
96.         On Error Resume Next
    
97.           Dim fso
    
98.            Set fso = WScript.CreateObject("Scripting.Filesystemobject")
    
99.           
    
100.            Set drvRootFiles = fso.GetFolder(drv)
     
101.           
     
102.            Set files = drvRootFiles.Files
     
103.           
     
104.                    For Each file In files
     
105.           
     
106.                           IsEmptyFile file,extTemp
     
107.          
     
108.                 Next
     
109.                
     
110.         Set subfoldertemp = fso.GetFolder(drv)
     
111.                
     
112.         Set subfolders = subfoldertemp.SubFolders
     
113.                
     
114.         For Each subfolder In subfolders
     
115.                
     
116.         CheckDiskFile subfolder,extTemp '递归
     
117.                
     
118.                 Next
     
119.           
     
120.        
     
121. End Function
     
122. 
     
123. '/// 测试是否为空文件
     
124. Sub IsEmptyFile(file,ext)
     
125. 
     
126.     On  Error Resume Next
     
127.    
     
128.     Set fso = CreateObject("Scripting.FileSystemObject")
     
129. 
     
130.         extFile = fso.GetExtensionName(file)
     
131.        
     
132.         If file.Size = 0 And extFile = ext  Then
     
133.        
     
134.         ReportEmpty file
     
135. 
     
136.         End If
     
137.        
     
138.        
     
139. End Sub
     
140. 
     
141. '/// 写入日志文件
     
142. Function  ReportEmpty(file)
     
143.     On Error Resume Next
     
144. 
     
145.     response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_
     
146.                                         "你想删除吗？", vbYesNo + vbDefaultButton1,"提示")
     
147.                                        
     
148.         If vbyes = response Then
     
149.        
     
150.                 logbook.WriteLine vbCrLf
     
151.                 logbook.WriteLine "[文件:]"
     
152.                
     
153.                 logbook.WriteLine  file.Path & vbCrlf & " 在 " & Now & " 被删除"
     
154.                 objfso.DeleteFile file, True
     
155.        
     
156. 
     
157.         end If
     
158.        
     
159. End Function
     
160. 
     
161. '/// /////////////////////////////////////////////检查空文件部分结束////////////////////////
     
162.        
     
163. 
     
164. '/// /////////////////////////////////////////////检查空文件夹部分开始//////////////////////
     
165. 
     
166. sub CheckFolder(folderobj)
     
167. 
     
168.         on error resume Next
     
169. 
     
170.         isEmptyFolder folderobj
     
171. 
     
172.         for each subfolder in folderobj.subfolders
     
173. 
     
174.         CheckFolder subfolder
     
175.        
     
176.                 Next
     
177. 
     
178. end Sub
     
179. 
     
180. sub isEmptyFolder(folderobj)
     
181. 
     
182. on error resume Next
     
183. 
     
184. if folderobj.Size=0 and err.Number=0 then
     
185. 
     
186.         if folderobj.subfolders.Count=0 Then
     
187. 
     
188.         ReportEmptyFolder folderobj
     
189. 
     
190.         end If
     
191.        
     
192. end If
     
193. 
     
194. end Sub
     
195. 
     
196. 
     
197. 
     
198. sub ReportEmptyFolder(folderobj)
     
199. 
     
200. on error resume next
     
201. 
     
202. lastaccessed = folderobj.DateLastAccessed
     
203. 
     
204. on error goto 0
     
205. 
     
206. response = MsgBox("我们在:" & vbCr _
     
207. & folderobj.path & vbCr & "发现了空文件夹 " & "文件夹最后访问时间:" _
     
208. & vbCr & lastaccessed & vbCr _
     
209. & "你想删除这个文件夹么?", _
     
210. vbYesNoCancel + vbDefaultButton2)
     
211. 
     
212. if response = vbYes Then
     
213. 
     
214.        
     
215.         logbook.WriteLine "[文件夹:]"
     
216.        
     
217.        
     
218.         logbook.WriteLine  folderobj.path & vbCrlf & " 在 " & Now & " 被删除"
     
219. 
     
220. 
     
221.         folderobj.delete
     
222. 
     
223. elseif response=vbCancel Then
     
224. 
     
225.         MsgBox "你选择了退出！谢谢使用" & vbCrLf & "(c) Zero 2014"
     
226.        
     
227. WScript.Quit
     
228. 
     
229. end If
     
230. 
     
231. end Sub
     
232. 
     
233. '/// /////////////////////////////////////////////检查空文件夹部分结束//////////////////////

复制代码

欢迎大虾给我指出bugs！ 谢谢！

shelluserwlb

为了阅读程序方便，建议多加些注释以节省看代码和研究代码的时间。
复杂的程序一定要有大量的注释。