none
[VBA] 刪除N天前的建立的資料夾 RRS feed

  • 問題

    • Office 的程式化處理(含物件模型,VSTO,SharePoint Server/WSS,OpenOffice XML以及其他使用 Office 做自動化處理的),請到 Office Systems開發討論區,但 VBA 語言則不在此限。

    因為看到這個所以再次發問 若有不適當頃版主代為刪除.對不起


    請問要如何修改成刪除N天的所"建立的資料夾"而不是檔案..謝謝!

    PS:我知道規局要先努力過..我從網上找到 ..修改日期的 改成 建立日期 在加上刪除記錄,尚未克服當無法刪除時另行記錄

        這個已經是努力過的了 , 請幫幫忙 謝謝!!

        ' 指定所有變數必須事先宣告才能使用  
        Option Explicit  
         
         
        WScript.Echo("作業開始執行:" & Date & " " & Time)  
        
        '宣告LOG FILE 變數
        Dim LogFSO, LogFile, FileName, MyDate
        
        '修改日期符號
        MyDate = Replace(Date, "/", "-") 
        Set LogFSO = CreateObject("Scripting.FileSystemObject")
        FileName = mydate & "-Log.txt"
        'Set LogFile = LogFSO.OpenTextFile(FileName, 2, True)  '覆蓋檔案
        Set LogFile = LogFSO.OpenTextFile(FileName, 8, True) '不覆蓋檔案
        
        
        
          
        ' 宣告變數  
        'Dim FSO, agoDays, modifiedDate, delFolder  
        Dim FSO, agoDays, CreatedDate, delFolder
          
        ' 請將下面的變數值換成你要的  
        ' == 開始 ==  
        ' 指定 n 天前的檔案,現在是 3 天前  
        agoDays = 3  
        ' 欲刪除檔案所在之目錄  
        delFolder = "D:\Script\test"  
        ' == 結束 ==  
          
        ' 建立檔案系統物件(File System Object)  
        Set FSO = CreateObject("Scripting.FileSystemObject")  
          
        ' 取得檔案的修改日期  
        'modifiedDate = DateAdd("d", -agoDays, Date)  
        
        ' 取得檔案的建立日期  
        CreatedDate = DateAdd("d", -agoDays, Date)  
        
          
        ' 呼叫刪除檔案的子程序  
        DelFilesInFolder FSO.GetFolder(delFolder)  
          
        ' 刪除檔案的子程序  
        Sub DelFilesInFolder(folder)  
            ' 宣告變數  
            Dim file, subFolder  
          
            ' 找出目前所在目錄內所有的檔案  
            For Each file In folder.Files  
                ' 檢查檔案日期是否符合條件,若符合,就刪除  
                'If ((file.DateLastModified <= modifiedDate)) Then  
                If ((file.DateCreated <= CreatedDate)) Then ' ' 檢查檔案建立日期是否符合條件,若符合,就刪除  
                
                '把將要刪除的檔案紀錄            '
                LogFile.WriteLine("DELETING - " & file.name & " LAST MODIFIED: " & file.DateLastModified & " CREATE DATE: " & file.DateCreated)
                
                '刪除檔案
                file.delete  
                
                End If  
            Next  
          
            ' 如果遇到子目錄,也要進去檢查並刪除  
            For Each subFolder in folder.SubFolders  
                DelFilesInFolder subFolder  
            Next  
        End Sub  
          
        WScript.Echo("作業執行完畢:" & Date & " " & Time)  


    2012年5月22日 下午 05:05

解答

  • 您好,

    請看以下的DelFilesInFolder Method, 在不符合的狀況下,再Call一次DelFilesInFolder Method就可以了!

    Sub DelFilesInFolder(folder)   ' 刪除檔案的子程序  
    	Dim Folders, subFolder     ' 宣告變數  
    	For Each Folders In folder.SubFolders               ' 找出目前所在目錄內所有的目錄  
    		If ((Folders.DateCreated <= CreatedDate)) Then ' 檢查資料夾建立日期是否符合條件,若符合,就刪除  
    			On Error Resume Next
    			LogFile.WriteLine("DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將要刪除的資料夾紀錄
    			FSO.DeleteFolder Folders '刪除目錄 
    			If Err Then
    			 err.Clear
    			 'Msgbox "不能刪除目錄,請檢查錯誤" 
    			 LogFile.WriteLine("CAN NOT DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將無法刪除的資料夾
    			End If
    		Else
    			'若沒符合就往下找目錄
    			Call DelFilesInFolder(Folders) 
    		End If  
    	Next  
    End Sub  


    以上說明若有錯誤請指教,謝謝。
    亂馬客blog: http://www.dotblogs.com.tw/rainmaker/

    • 已標示為解答 X Z 2012年5月24日 上午 01:36
    2012年5月23日 下午 03:41

所有回覆

  • 您好,

    請參考

    METHOD:  FileSystemObject.GetFolder

    可透過取回Folder物件的DateCreated屬性取得建立日期。

    METHOD:  FileSystemObject.DeleteFolder

    不過,logic會變成,日期不在n天前才往子目錄去找!


    以上說明若有錯誤請指教,謝謝。
    亂馬客blog: http://www.dotblogs.com.tw/rainmaker/

    2012年5月22日 下午 11:10
  • 謝謝您
    可是我改不太出來 有錯誤和問題
    請您再幫幫忙,謝謝

        ' 指定所有變數必須事先宣告才能使用  
        Option Explicit  
         
        WScript.Echo("作業開始執行:" & Date & " " & Time)  
    
        Dim LogFSO, LogFile, FileName, MyDate     '宣告LOG FILE 變數
        MyDate = Replace(Date, "/", "-") '修改日期符號
        Set LogFSO = CreateObject("Scripting.FileSystemObject")
        FileName = mydate & "-Log.txt"
        Set LogFile = LogFSO.OpenTextFile(FileName, 8, True) '不覆蓋檔案
          
        Dim FSO, agoDays, CreatedDate, delFolder    ' 宣告變數  
          
        agoDays = 3  ' 指定 n 天前的檔案,現在是 3 天前  
        delFolder = "D:\Script\test"      ' 欲刪除檔案所在之目錄  
    
        Set FSO = CreateObject("Scripting.FileSystemObject")      ' 建立檔案系統物件(File System Object)  
        CreatedDate = DateAdd("d", -agoDays, Date)   ' 取得資料夾的建立日期
        DelFilesInFolder FSO.GetFolder(delFolder)  ' 呼叫刪除資料夾的子程序  
        
        Sub DelFilesInFolder(folder)   ' 刪除檔案的子程序  
            Dim Folders, subFolder     ' 宣告變數  
            For Each Folders In folder.SubFolders               ' 找出目前所在目錄內所有的目錄  
                If ((Folders.DateCreated <= CreatedDate)) Then ' 檢查資料夾建立日期是否符合條件,若符合,就刪除  
                LogFile.WriteLine("DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將要刪除的檔案紀錄
                FSO.DeleteFolder Folders  '刪除目錄  
                End If  
            Next  
        End Sub  
          
        WScript.Echo("作業執行完畢:" & Date & " " & Time)  

    除了您提供的,我還搜尋數篇

    File and Folder Procedures
    Delete folder contents and subfolders contents based on date created.

    但是我還是改不出來阿

    AM 5/23 10:00

    =======================

    後來改出來了 原來路徑要在後面 程序不妥的地方勞煩指正一下
    因為是東拼西湊的

    現在有個問題 若資料夾內有使用中的檔案
    程式會停止:
    請指導一下 如何將跳過錯誤的資料夾並記錄 無法刪除
    目前是先記錄再刪除 感覺有點不完善

    =======================


    • 已編輯 X Z 2012年5月23日 上午 02:17
    2012年5月23日 上午 01:54
  • 找到錯誤了 後面不能加TRUE

    請問這樣改有什麼缺失需要注意的嗎?

    謝謝

                 On Error Resume Next
                
                FSO.DeleteFolder Folders(True) '刪除目錄
                LogFile.WriteLine("DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將要刪除的檔案紀錄           
        ' 指定所有變數必須事先宣告才能使用  
        Option Explicit  
         
        WScript.Echo("作業開始執行:" & Date & " " & Time)  
    
        Dim LogFSO, LogFile, FileName, MyDate     '宣告LOG FILE 變數
        MyDate = Replace(Date, "/", "-") '修改日期符號
        Set LogFSO = CreateObject("Scripting.FileSystemObject")
        FileName = mydate & "-Log.txt"
        Set LogFile = LogFSO.OpenTextFile(FileName, 8, True) '不覆蓋檔案
          
        Dim FSO, agoDays, CreatedDate, delFolder    ' 宣告變數  
          
        agoDays = 3  ' 指定 n 天前的檔案,現在是 3 天前  
        delFolder = "D:\Script\test"      ' 欲刪除檔案所在之目錄  
    
        Set FSO = CreateObject("Scripting.FileSystemObject")      ' 建立檔案系統物件(File System Object)  
        CreatedDate = DateAdd("d", -agoDays, Date)   ' 取得資料夾的建立日期
        DelFilesInFolder FSO.GetFolder(delFolder)  ' 呼叫刪除資料夾的子程序  
        
        Sub DelFilesInFolder(folder)   ' 刪除檔案的子程序  
            Dim Folders, subFolder     ' 宣告變數  
            For Each Folders In folder.SubFolders               ' 找出目前所在目錄內所有的目錄  
                If ((Folders.DateCreated <= CreatedDate)) Then ' 檢查資料夾建立日期是否符合條件,若符合,就刪除  
                On Error Resume Next
                
                LogFile.WriteLine("DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將要刪除的資料夾紀錄
                FSO.DeleteFolder Folders '刪除目錄 
                If Err Then
                 err.Clear
                 'Msgbox "不能刪除目錄,請檢查錯誤" 
                 LogFile.WriteLine("CAN NOT DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將無法刪除的資料夾
                End If       
                End If  
            Next  
        End Sub  
          
        WScript.Echo("作業執行完畢:" & Date & " " & Time)




    • 已編輯 X Z 2012年5月23日 上午 03:54 找到問題 尋求改進
    2012年5月23日 上午 03:40
  • 您好,

    請問 For Each Folders In folder.SubFolders  中,如果不符合日期的目錄,需要再檢查它的子目錄是否符合嗎?


    以上說明若有錯誤請指教,謝謝。
    亂馬客blog: http://www.dotblogs.com.tw/rainmaker/

    2012年5月23日 上午 05:13
  • Hi ~

    說實話 我還真的看不太懂 ,我是東湊西拼再改的
    For Each Folders In folder.SubFolders
    我猜這句應該是 資料夾於指定目錄的資料夾

    我的需求是刪除 刪除TestFloder以下的資料夾,裡面不管有幾層都砍了
    因為第一層核對後 不就裡面都砍了 怎麼往下核對日期
    勞煩您了 謝謝.

    └─TestFloder
        │  test.txt
        │
        ├─TestFloder-20120515
        │  │  test
        │  │  test.txt
        │  │
        │  └─TestFloder-2
        │          test.txt
        │
        ├─TestFloder-20120516
        │  │  test
        │  │  test.txt
        │  │
        │  └─TestFloder-2
        │          test.txt
        │
        ├─TestFloder-20120517
        │  │  test
        │  │  test.txt
        │  │
        │  └─TestFloder-2
        │          test.txt
        │
        ├─TestFloder-20120518
        │  │  test
        │  │  test.txt
        │  │
        │  └─TestFloder-2
        │          test.txt
        │
        └─TestFloder-20120519
            │  test
            │  test.txt
            │
            └─TestFloder-2
                    test.txt

    PS:之後還要想辦法改個..針對檔名判斷的..這個感覺難度更高..對我來說ˇˇ

    2012年5月23日 上午 05:38
  • 殺了上層目錄,下層目錄的檔案及目錄都沒了。

    沒殺的目錄,就用遞迴自我呼叫。

    還有線上手冊要安裝。


    Folders 集合物件

    包含在某 Folder 物件內所有 Folder 物件的集合物件。


    附註

    [JScript]

    下面的範例說明如何使用 Enumerator 物件和 for 陳述式取得 Folders
    集合物件,以及如何反覆處理此集合物件︰

    [JScript]
    function ShowFolderList(folderspec)
    {
       var fso, f, fc, s;
       fso = new ActiveXObject("Scripting.FileSystemObject");
       f = fso.GetFolder(folderspec);
       fc = new Enumerator(f.SubFolders);
       s = "";
       for (; !fc.atEnd(); fc.moveNext())
       {
          s += fc.item();
          s += "<br>";
       }
       return(s);
    }

    [VBScript]

    下面的範例說明如何使用 For Each...Next 陳述式取得 Folders 集合以及以及如何反覆處理此集合:

    [VBScript]
    Function ShowFolderList(folderspec)
       Dim fso, f, f1, fc, s
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set f = fso.GetFolder(folderspec)
       Set fc = f.SubFolders
       For Each f1 in fc
          s = s & f1.name 
          s = s &   "<BR>"
       Next
       ShowFolderList = s
    End Function

    方法


    論壇是網友平等互助 保證解答請至 微軟技術支援服務


    提問時,錯誤情境描述與錯誤訊息很重要,情境描述包含你做了什麼,預期的結果與實際發生的結果。一個最爛的問法範例:「我的電腦電腦怎麼不能開機?」誰知道你家是不是沒電還是你根本找不到電源鈕。

    2012年5月23日 下午 03:01
  • 謝謝您 程式碼我需要領悟一下

    還有線上手冊要安裝。<= 這個是什麼?


    2012年5月23日 下午 03:12
  • 您好,

    請看以下的DelFilesInFolder Method, 在不符合的狀況下,再Call一次DelFilesInFolder Method就可以了!

    Sub DelFilesInFolder(folder)   ' 刪除檔案的子程序  
    	Dim Folders, subFolder     ' 宣告變數  
    	For Each Folders In folder.SubFolders               ' 找出目前所在目錄內所有的目錄  
    		If ((Folders.DateCreated <= CreatedDate)) Then ' 檢查資料夾建立日期是否符合條件,若符合,就刪除  
    			On Error Resume Next
    			LogFile.WriteLine("DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將要刪除的資料夾紀錄
    			FSO.DeleteFolder Folders '刪除目錄 
    			If Err Then
    			 err.Clear
    			 'Msgbox "不能刪除目錄,請檢查錯誤" 
    			 LogFile.WriteLine("CAN NOT DELETING - " & Folders.name & " LAST MODIFIED: " & Folders.DateLastModified & " CREATE DATE: " & Folders.DateCreated)  '把將無法刪除的資料夾
    			End If
    		Else
    			'若沒符合就往下找目錄
    			Call DelFilesInFolder(Folders) 
    		End If  
    	Next  
    End Sub  


    以上說明若有錯誤請指教,謝謝。
    亂馬客blog: http://www.dotblogs.com.tw/rainmaker/

    • 已標示為解答 X Z 2012年5月24日 上午 01:36
    2012年5月23日 下午 03:41
  • 還有線上手冊要安裝。<= 這個是什麼?


    上面的內容就是從線上手冊剪貼出來的。

    論壇是網友平等互助 保證解答請至 微軟技術支援服務


    提問時,錯誤情境描述與錯誤訊息很重要,情境描述包含你做了什麼,預期的結果與實際發生的結果。一個最爛的問法範例:「我的電腦電腦怎麼不能開機?」誰知道你家是不是沒電還是你根本找不到電源鈕。

    2012年5月23日 下午 05:13