ExcelVBAで別ファイルの更新を検知する

作業用のエクセルファイルを開いた時に、そのエクセルに入る情報を別のエクセルファイルから取り出す場合に、その別エクセルファイルが違う人によって更新されているか？の確認をわざわざエクセルファイルを開かなくても確認できるVBAです。

このVBAで作業用エクセルファイルを開くだけで確認できるので３手間くらい助かります。

手法としてはエクセルファイルのタイムスタンプ（更新履歴）を参照して、前回の更新履歴から更新されているか？を判断してお知らせします。

今回は、フォルダに入っているすべてのファイルのタイムスタンプを取得して、その中で更新を知りたいファイルを選択して更新確認をします。以下のスクリプトを改造すれば、フォルダ内全部のタイムスタンプを取らずともファイル単体のタムスタンプが取れます。

作業用のエクセルファイルを開いた時にフォルダ内にあるエクセルファイルのタイムスタンプを収集します。

以下の記述内容は「ThisWorkbook」に記述します。

Private Sub Workbook_open() から End Sub までがエクセルファイルを開いた時にフォルダ内にあるエクセルファイルのタイムスタンプを取得します。

n = Cells(Rows.Count, “A”).End(xlUp).Row + 1　でフォルダ内のエクセルファイルすべてを追記していきます。それを降順でソートすることによりvlookupで新しいタイムスタンプを認識できるようになります。

PathName = Worksheets(“Sheet2”).Range(“F4”)　はF4セルからのフォルダパスを取得します。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)　はエクセルファイルを保存して閉じる時に実行されるプロシージャです。

エクセルファイルを開いた時に取得したエクセルファイルのタイムスタンプを転記しています。これにより次にエクセルを開いた時に取得したタイムスタンプと齟齬していれば更新されたと認識することができます。

Private Sub Workbook_open()

 n = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
 PathName = Worksheets("Sheet2").Range("F4")
 buf = Dir(PathName & "*.xlsx")

   Do While buf <> ""
      Worksheets("Sheet1").Cells(n, 1) = buf
      Worksheets("Sheet1").Cells(n, 2) = FileDateTime(PathName & buf)

      buf = Dir()
      n = n + 1
   Loop
   
 Worksheets("Sheet1").Range("A1").Sort _
 Key1:=Worksheets("Sheet1").Range("B1"), Order1:=xlDescending, Header:=xlYes

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
 Worksheets("Sheet2").Range("d4").Value = Worksheets("Sheet2").Range("e4").Value

End Sub

「Sheet1」です。

開くたびにどんどん追記されていきます。

「CommandButton1」は個別に手動でタイムスタンプを取得するためのものです。

「Sheet2」です。

B4セルの「更新」表示はE4セルがD4セルより大きくなった場合に「更新」と表示されます。

=IF(D4<E4,”更新”,””)

という関数を入れてあります。

E4セルの「更新後」表示は

=VLOOKUP($C$4,Sheet1!$A$2:$B$1000,2,FALSE)

でSheet1の降順表からC4セルの「ファイル名」に該当するもののタイムスタンプをひっぱってきています。

F4セルのフォルダパスはC4のファイルがある所までのフォルダパスです。最後に￥をいれて指定します。

「Comma」は手動更新でE4セルからD4セルに転記する手動ボタンです。

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル