12
返回列表 上一主題 發帖

刪除資料夾內的檔案

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
11# 跳轉到 »
發表於 2012-10-25 16:19 | 只看該作者
回復 2# oobird

請教大大,

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2012-10-25 18:32 | 只看該作者
本帖最後由 GBKEE 於 2012-10-26 07:24 編輯

回復 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
複製代碼

TOP

linsurvey2005

帖子
84 
主題
15 
精華
0 
積分
123 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2011-5-16 
最後登錄
2022-9-17 
13#
發表於 2012-10-25 18:57 | 只看該作者
回復 9# GBKEE


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

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2012-10-26 07:36 | 只看該作者
回復 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
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
15#
發表於 2012-10-26 09:15 | 只看該作者
回復 12# GBKEE

G大,

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2012-10-26 09:27 | 只看該作者
回復 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
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2012-10-26 10:14 | 只看該作者
回復 16# GBKEE

大大,

感謝!!
成功了!

TOP

linsurvey2005

帖子
84 
主題
15 
精華
0 
積分
123 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2011-5-16 
最後登錄
2022-9-17 
18#
發表於 2012-10-26 18:58 | 只看該作者
回復 14# GBKEE


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2012-10-26 21:17 | 只看該作者
回復 18# linsurvey2005
不是已經給你程式碼了,試著去修改 ,才會是自己的.

TOP

linsurvey2005

帖子
84 
主題
15 
精華
0 
積分
123 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台南市 
註冊時間
2011-5-16 
最後登錄
2022-9-17 
20#
發表於 2012-10-27 12:04 | 只看該作者
回復 19# GBKEE


    感謝大大，無私指導
開心學習,學習很開心

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
12
返回列表 上一主題