エクセル100本ノック 21 ~ 30

21問目 : バックアップファイルを作成する

問題

1か月以上経過したバックアップファイルを削除する。

解答

  Dim backupDirectory As String
  Const BACKUP_FOLDER_NAME As String = "BACKUP"
  
  Dim fso As New FileSystemObject
  Dim f As file

  ' バックアップフォルダが存在しない場合, 終了
  backupDirectory = ThisWorkbook.Path & "\\" & BACKUP_FOLDER_NAME
  If Not fso.FolderExists(backupDirectory) Then
    Exit Sub
  End If
    
  For Each f In fso.GetFolder(backupDirectory).Files
    ' 日付の差が1か月以上ある場合
    If DateDiff("m", f.DateCreated, Now) >= 1 Then
      f.Delete True
    End If
  Next  
  
  Set fso = Nothing

別解

 'f.DateCreatedを用いず、バックアップファイル名から日付を抽出する場合。
 ' バックアップの年月日を取得
 Dim yyyymmdd As String
 yyyymmdd = f.Name
 yyyymmdd = Mid(yyyymmdd, Len(fso.GetBaseName(ThisWorkbook.Name)) + 2)
 yyyymmdd = Left(yyyymmdd, 8)

 Dim d As Date
 d = DateSerial(Mid(yyyymmdd, 1, 4), Mid(yyyymmdd, 5, 2), Mid(yyyymmdd, 7, 8))
 If DateDiff("m", d, Now) >= 1 Then
 

ポイント