Sub OldFileDelete(strFolder, numDays) Dim objFSO Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim MyFolder Set MyFolder = objFSO.GetFolder(strFolder)
Dim MyFileName For Each MyFileName In MyFolder.Files If DateDiff("d", MyFileName.DateLastModified, date) >= numDays Then On Error Resume Next objFSO.DeleteFile MyFileName On Error Goto 0 End If Next
Set MyFileName = Nothing Set MyFolder = Nothing Set objFSO = Nothing
End Sub
■指定フォルダの指定個数分最新のものを残してファイルを削除する関数
Sub OldFileDelete2(strFolder, numDays)
Dim rs Set rs = CreateObject("ADODB.Recordset") Call rs.Fields.Append("LastModified", 4) Call rs.Fields.Append("FileName", 130, 1000) Call rs.Open()
Dim objFSO Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim MyFolder Set MyFolder = objFSO.GetFolder(strFolder)
Dim WshShell set WshShell = WScript.CreateObject("WScript.Shell")
Dim objShortcut
Dim MyFileName For Each MyFileName In MyFolder.Files
On Error Resume Next Set objShortcut = WshShell.CreateShortcut(strFolder &"\"& MyFileName.Name) ' LNKファイル以外はエラーとなる(index.dat を除外) If Err.Number = 0 Then On Error Goto 0
If objFSO.FolderExists(objShortcut.TargetPath) Then On Error Resume Next ' リンク先がフォルダであればリンクファイルを削除 objFSO.DeleteFile strFolder &"\"& MyFileName.Name On Error Goto 0 ElseIf objFSO.FileExists(objShortcut.TargetPath) Then Call rs.AddNew() rs.Fields("FileName").Value = MyFileName.Name rs.Fields("LastModified").Value = MyFileName.DateLastModified Call rs.Update() Else ' リンク先がリンク切れフォルダまたはリンク切れファイルであればリンクファイルを削除 On Error Resume Next objFSO.DeleteFile strFolder &"\"& MyFileName.Name On Error Goto 0 End If
Else On Error Goto 0 ' WScript.Echo strFolder &"\"& MyFileName.Name End If
Next
rs.Sort = "LastModified DESC"
If rs.RecordCount > numDays Then Call rs.Move(numDays) Do Until rs.EOF On Error Resume Next objFSO.DeleteFile strFolder &"\"& rs.Fields("FileName").Value On Error Goto 0 rs.MoveNext Loop End If
Call rs.Close()
Set MyFileName = Nothing Set MyFolder = Nothing Set objFSO = Nothing Set rs = Nothing
End Sub