[tool][VBScript] 用來刪除空資料夾的小工具

因為有些程式或 3rd-party 工具會產生一些暫時用的資料夾, 為了管理方便, 會想定時清掉沒資料或是過期的的資料夾. 這個小工具就是為了做這種事而寫的.
以下的程式可以包裝成 .vbs 檔, 然後設定到每日排程去執行.

Dim oFS   
Dim oFSFolder   
Dim sPath, sFlagPath, nExpireDays

Dim dFlagDate
' 根目錄
sPath = "D:\test"
' 用來比對資料是否過期的 flag 檔案
sFlagPath = sPath & "\flag"
' 預設3天前的資料夾算是過期的資料夾
nExpireDays = -3

Set oFS = CreateObject("Scripting.FileSystemObject") 

' 判斷根目錄是否存在
If Not oFS.FolderExists(sPath) Then 
  Set oFS = Nothing 
  WScript.Quit 0
End If 

' 讀取後續要做日期判斷的設定值
dFlagDate = ReadDateFlag(sFlagPath)

Set oFSFolder = oFS.GetFolder(sPath) 
' 取得根目錄下所有的子目錄
Set fDates = oFSFolder.SubFolders
For Each fDateItem in fDates
  If fDateItem.DateLastModified <= dFlagDate Then
    ' 利用遞迴的方式刪除不要(空)的資料夾
    DeleteEmptyFolder(fDateItem)
  End If
Next
Set oFSFolder = Nothing 
Set oFS = Nothing 

Sub DeleteEmptyFolder(oFolder) 
  Set oFSFolder = oFS.GetFolder(oFolder.Path)
  Set fItems = oFSFolder.SubFolders
  ' 這邊是判斷檔案和資料夾都為空的情況, 如果是要刪過期的資料, 可再另外判斷
  If (oFSFolder.SubFolders.Count + oFSFolder.Files.Count)=0 Then
    ' 如果此資料夾底下無資料, 刪除此資料夾
    oFS.DeleteFolder oFSFolder.Path
  Else 
    ' 如果有檔案或是資料夾, 繼續往下進行刪除的動作
    For Each fItem in fItems
      DeleteEmptyFolder(fItem)
    Next
  End If
End Sub

Function ReadDateFlag(sFlagPath)
  Dim fFlag, dFlagDate, strDate
  strDate = ""
  If Not oFS.FileExists(sFlagPath) Then
    ' 如果 flag 檔不存在, 將預設的日期資料寫入 flag 檔
    dFlagDate = DateAdd("d", nExpireDays, Date)
    ' 日期格式為: yyyy-MM-dd
    strDate = Year(dFlagDate) & "-" & Month(dFlagDate) & "-" & Day(dFlagDate)
    Set fFlag = oFS.OpenTextFile(sFlagPath, 8, True)
    fFlag.Write strDate
    fFlag.Close
    ReadDateFlag = CDate(strDate)
  Else
    ' 如果 flag 檔已存在, 讀取上次執行的日期戳記
    Set fFlag = oFS.OpenTextFile(sFlagPath, 1)
    If strDate="" Then
      If Not fFlag.AtEndOfStream Then
        strDate = fFlag.ReadLine
        dFlagDate = DateAdd("d", 1, CDate(strDate))
        strDate = Year(dFlagDate) & "-" & Month(dFlagDate) & "-" & Day(dFlagDate)
      End If
    End If
    fFlag.Close
    ' 用覆寫的方式寫回 flag 檔
    Set fFlag = oFS.OpenTextFile(sFlagPath, 2, True)
    fFlag.Write strDate
    fFlag.Close
    ReadDateFlag = CDate(strDate)
  End If  
End Function

相關參考資料:

• Scripting.FileSystemObject
• Scripting.FileSystemObject 的 OpenTextFile