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秒おきに行っているので、このマクロをバックグラウンドで実行していれば、最新ファイルが保存されれば、数秒でメッセージボックスが出る。

最新ファイルさえ分かれば、開いてシート内データをコピー、編集すればいいだけなので、何とかなりそう。