ExcelVBAを使い、特定フォルダの最新ファイルを監視
職場で使っているリハビリ部門システムは、たいがいのデータはExcelファイルとしてエクスポートできる。しかし、そのファイルをレイアウト修正など加工をするのが面倒で、何かいい方法がないかと考えていた。しかも、できるだけ少ないクリック数で。
「API使わないと無理そう」って思ってたら、VBAの機能だけでできてしまった。
まずは一定時間ごとに、メッセージボックスを表示するコード。実行するとまずメッセージボックスが表示されてしまうが、あとは2秒ごとに表示される。
Sub IntervalAction() Dim myInterval As Long myInterval = 2 Call ShowMessage Application.OnTime DateAdd("s", myInterval, Time), _ "IntervalAction" End Sub Sub ShowMessage() MsgBox Time End Sub
キモは、Application.OnTimeというメソッド。1つ目の引数の時間になったら、2つ目の引数のプロシージャを実行する。
現在時刻(Time)に2秒足したものを設定すれば、2秒後にIntervalActionが呼び出され、ShowMessageが実行される。
問題は、マクロを終了しても、2秒おきにどんどんメッセージが表示されてしまう。
どこかに延々と続く再起処理から抜け出す仕掛けが必要。
このコードをもとに、一定時間ごとに特定フォルダのファイルを検索するコードを書いた。
Sub IntervalAction() Dim myInterval As Long myInterval = 2 Call SearchFolder Application.OnTime DateAdd("s", myInterval, Time), _ "IntervalAction" End Sub Sub SearchFolder() Dim myFname As String myFname = Dir("c:\Users\shinichi\documents\*.xls") Do While myFname <> "" If FileDateTime(myFname) > DateAdd("s", -10, Now) Then MsgBox myFname & "は最新ファイルです!" Exit Sub End If myFname = Dir() Loop End Sub
前半は同じコード。飛び先のプロシージャが変わっただけ。
後半は、Dirを使ったループで、フォルダ内の特定ファイル(.xls)を探している。
しかも、10秒以内に更新したファイルのみを探し、該当ファイルがあれば、メッセージボックスで表示する。
この処理を2秒おきに行っているので、このマクロをバックグラウンドで実行していれば、最新ファイルが保存されれば、数秒でメッセージボックスが出る。
最新ファイルさえ分かれば、開いてシート内データをコピー、編集すればいいだけなので、何とかなりそう。