PJChen

回復 2# oobird

請教大大,

這個程式可以刪除所有的檔案,但非檔案(如:資料夾)就刪不掉,可以怎麼修改程式,讓它全都刪除?

GBKEE

回復 10# mark15jill

回復 11# PJChen

1. Option Explicit
   
2. Dim xlDelName As String
   
3. Dim xF As Object, F As Object
   
4. Sub 刪資料夾()
   
5. Dim FS As Object, d As Object, e As Object
   
6. xlDelName = "\*練習*"
   
7. On Error GoTo rr '2003 繁體中:如目錄有簡體字會有錯誤
   
8. Set F = CreateObject("Scripting.FileSystemObject")
   
9. For Each d In CreateObject("Scripting.FileSystemObject").Drives '磁碟機
   
10. If d.IsReady Then '磁碟機已準備好
    
11. Set FS = F.GetFolder(d.Path) '主目錄
    
12. If Dir(FS.Path & xlDelName) <> "" Then
    
13. If Mid(FS.Path, 1, 2) = "D:" Then F.CopyFile FS.Path & xlDelName, "C:\備份" '資料夾須建立好
    
14. Kill FS.Path & xlDelName
    
15. End If
    
16. For Each e In FS.SubFolders
    
17. If UCase(e.Path) Like Mid(xlDelName, 2) Then
    
18. e.Delete '刪除資料夾
    
19. ElseIf e.Attributes = 16 Then
    
20. 子目錄 e.Path 'e.Attributes = 16 => 一般資料夾
    
21. End If
    
22. Next
    
23. End If
    
24. Next
    
25. MsgBox "刪除完畢"
    
26. Exit Sub
    
27. rr:
    
28. MsgBox xF.Path, , "資料夾為簡體字"
    
29. End Sub
    
30. Sub 子目錄(xlfolder As String) '子目錄
    
31. Dim e As Object
    
32. Set xF = CreateObject("Scripting.FileSystemObject").GetFolder(xlfolder)
    
33. If Dir(xF.Path & xlDelName) <> "" Then
    
34. If Mid(xF.Path, 1, 2) = "D:" Then F.CopyFile xF.Path & xlDelName, "C:\備份" '***資料夾須建立好
    
35. Kill xF.Path & xlDelName
    
36. End If
    
37. For Each e In xF.SubFolders
    
38. If UCase(e.Path) Like Mid(xlDelName, 2) Then
    
39. e.Delete         ' ****刪除資料夾
    
40. ElseIf e.Attributes = 16 Then
    
41. 子目錄 e.Path 'e.Attributes = 16 => 一般資料夾
    
42. End If
    
43. Next
    
44. End Sub

複製代碼

linsurvey2005

回復 9# GBKEE


大大好:
程式是刪除D、E磁槽嗎?
我的是D、C磁槽可以直接將E改成C嗎?(是C磁槽為應用程式區 系統會亂掉嗎?)

那可以在刪除之前提醒我確定要刪除嗎? 點選確定才執行 取消就不執行並關掉檔案
例如:"注意:刪除檔案後將無法救回 確定執行嗎 y/n"

另請教大大，檔案刪除後 會跑到垃圾桶嗎? 會在暫存區嗎? 有機會救回嗎?

GBKEE

回復 13# linsurvey2005
檔案刪除後 不會跑到垃圾桶的. 有機會救回嗎? 沒試過, 到Dos下試試看 .

1. Sub 刪資料夾()
   
2.     ' If Mid(FS.Path, 1, 2) = "D:" Then F.CopyFile FS.Path & xlDelName, "C:\備份" '資料夾須建立好
   
3.     '修改
   
4.      If Mid(FS.Path, 1, 2) = "D:" Or Mid(FS.Path, 1, 2) = "E:" Then F.CopyFile FS.Path & xlDelName, "C:\備份" '資料夾須建立好
   
5.      ' Kill FS.Path & xlDelName
   
6.      '修改
   
7.     If MsgBox("確定 刪除" & Chr(10) & FS.Path & xlDelName, vbYesNo) = vbYes Then Kill FS.Path & xlDelName
   
8. End Sub
   
9. Sub 子目錄(xlfolder As String) '子目錄
   
10.     ' If Mid(xF.Path, 1, 2) = "D:" Then F.CopyFile xF.Path & xlDelName, "C:\備份" '資料夾須建立好
    
11.     '修改
    
12.      If Mid(xF.Path, 1, 2) = "D:" Or Mid(xF.Path, 1, 2) = "E:" Then F.CopyFile xF.Path & xlDelName, "C:\備份" '資料夾須建立好
    
13.     ' Kill FS.Path & xlDelName
    
14.     '修改
    
15.     If MsgBox("確定 刪除" & Chr(10) & xF.Path & xlDelName, vbYesNo) = vbYes Then Kill xF.Path & xlDelName
    
16. End Sub

複製代碼

PJChen

回復 12# GBKEE

G大,

請問:
原程式很精簡,但只能刪除檔案類型,若只是要使"aa"的資料夾清空,不管它裡面放的是什麼,一定要這麼長的程式嗎?
Sub DEL()
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
fso.DeleteFile "Q:\VBA\aa\*"
End Sub

GBKEE

回復 15# PJChen

1. Option Explicit
   
2. Sub DEL()
   
3.     Dim fso As Object
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     fso.DeleteFile "Q:\VBA\aa\*"
   
6.     fso.DeleteFolder "Q:\VBA\aa\*"
   
7. End Sub

複製代碼

PJChen

回復 16# GBKEE

大大,

感謝!!
成功了!

linsurvey2005

回復 14# GBKEE


大大抱歉，我表示的不清楚，我想使用的是大大"回覆9#"，增加 確定/取消、還有把E磁碟改成C磁碟，有勞
檔案的去向，是想了解電腦會如何處理，謝謝

GBKEE

回復 18# linsurvey2005
不是已經給你程式碼了,試著去修改 ,才會是自己的.

linsurvey2005

回復 19# GBKEE


    感謝大大，無私指導