エクセルでファイルの作成日時と更新日時を調べて比較する

対象のディレクトリを再帰的に調べ、各ディレクトリに含まれるファイルの作成日時と最終更新日時を比較するマクロ。差異があるファイルに関しては背景色を変更する。

Option Explicit

Sub foo()
  Dim strFindroot
  strFindroot = "C:\WINDOWS\System32"
  
  ''' Init '''
  Cells.Clear
  Cells.Delete
  
  Dim intCounter
  intCounter = 1
  
  recursive strFindroot, intCounter
  
  ''' Format '''
  Columns(1).HorizontalAlignment = xlRight
  Columns(1).IndentLevel         = 1
  Columns(4).NumberFormatLocal   = "#,##0, ""KB"""
  Columns(5).NumberFormatLocal   = "YYYY/MM/DD hh:mm:ss"
  Columns(6).NumberFormatLocal   = "YYYY/MM/DD hh:mm:ss"
  Columns(7).HorizontalAlignment = xlCenter
  
  ''' Label '''
  Rows(1).Insert
  Rows(1).HorizontalAlignment = xlCenter
  Cells(1, 1) = "ID"
  Cells(1, 2) = "Directory"
  Cells(1, 3) = "Name"
  Cells(1, 4) = "Size"
  Cells(1, 5) = "Created"
  Cells(1, 6) = "Modified"
  Cells(1, 7) = "Match"
  
  ''' Auto Filter '''
  Cells(1, 7).Select
  Selection.AutoFilter
  
  ''' Fitting '''
  With Cells
    .Font.Name = "MS Mincho"
    .Font.Size = 10
    .Columns.AutoFit
  End With
End Sub

Private Sub recursive(ByVal path, ByRef intCounter)
  Dim FSO
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  Dim f
  For Each f In FSO.GetFolder(path).Files
    Cells(intCounter, 1) = intCounter
    Cells(intCounter, 2) = FSO.GetParentFolderName(f)
    Cells(intCounter, 3) = FSO.GetFileName(f)
    Cells(intCounter, 4) = f.Size
    Cells(intCounter, 5) = f.DateCreated
    Cells(intCounter, 6) = f.DateLastModified
    
    If Cells(intCounter, 5) <> _
       Cells(intCounter, 6) _
    Then
      Cells(intCounter, 7) = "N"
      Range(Cells(intCounter, 1), _
            Cells(intCounter, 6)).Interior.ColorIndex = 3
    Else
      Cells(intCounter, 7) = "Y"
    End If
    
    intCounter = intCounter + 1
  Next
  
  For Each f In FSO.GetFolder(path).SubFolders
    recursive f, intCounter
  Next
End Sub

テスト的なものなのでファイルの作成・更新日時以外に関係ないものも入ったりしてる。Cells(y, x) で指定するよりも適当な変数に割り当てた方がいいかもしれない。VBScript ではファイルの作成・更新日時の表示形式を調整するのが面倒だけど Excel だと表示形式が簡単に指定できるので楽だった。

VBA でセルに数式を入れる場合にダブルクオートが含まれる場合はダブルクオートを2つ使うことでエスケープ出来るらしい。へ、へぇ…（なんでこんな仕様なんだ）。

Cells(1, 1).Formula = "IF(INDIRECT(ADDRESS(ROW(), COLUMN()+1))=INDIRECT(ADDRESS(ROW(), COLUMN()+2)), ""○"", ""×"")"

今回のマクロは仕事で使えるかな〜と思って作ってみたんだけど、ファイルの改竄に関してファイルの更新日時を調べるのもいいけど、SHA-1 とかを使ったほうが破損とかにも対応できていいと思うのだけど。Windows はコマンドが入っていないけど crypt.dll を使えば出来ないこともなさそう。