Accessでリンクテーブルのリンク元ファイルの更新時間を確認するマクロ
Accessでリンクテーブルを使用し、かつそのリンク元ファイルを他の人が定期的に更新して運用するような場合、リンク元ファイルを見に行かないと、元ファイルが更新し終わったのかどうかは分からないと思います(そうですよね…?)そもそも、更新日を見て判断するという手順がおかしい
ですが、「リンク元ファイルはどこにあるんだっけ?」などと毎回やるのも嫌なので、
- リンクテーブルのリンク先パス、
- 更新日、
- 更新日が1月以内かどうかのCheck
について、出力してくれるマクロを作成しました
同様の作業を行っている人が結構いるのではないかと思っているのですが、その割にネットにコードが転がっていなかったのでアップしてみました(と言ってもほぼ参考サイトのコードを組み合わせただけですけどね)
参考サイト:
リンク先のデータベースファイル名を取得するには?
VBA ファイルの作成日時や更新日時を取得または変更する
Access VBA:リンクテーブルのリンク元をVBAで変更する方法(リンクテーブルをループで処理する箇所)
Option Compare Database
Option Explicit
Sub GetLinkTableDates()
Dim fso As Object 'FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Object 'File
Dim db As DAO.Database, td As DAO.TableDef, filePath As String, msg As String
Set db = CurrentDb
For Each td In db.TableDefs
If td.Connect <> "" Then 'リンクテーブルだけを処理
filePath = Mid$(td.Connect, InStr(td.Connect, ";DATABASE=") + Len(";DATABASE="))
msg = msg & "テーブル名:" & td.Name & vbNewLine
msg = msg & filePath & vbNewLine
Set f = fso.GetFile(filePath)
'msg = msg & "DateCreated:" & formatDate(f.DateCreated) & vbNewLine
msg = msg & "DateLastModified:" & formatDate(f.DateLastModified) & vbNewLine & vbNewLine
'msg = msg & "DateLastAccessed:" & formatDate(f.DateLastAccessed) & vbNewLine & vbNewLine
End If
Next
MsgBox msg
Set fso = Nothing
End Sub
Private Function formatDate(target_date As Date)
Dim strCheck As String
If DateAdd("m", 1, Date) < target_date Then
strCheck = ""
Else
strCheck = "Check!! (1月以上前)"
End If
formatDate = Chr(9) & target_date & Chr(9) & strCheck
End Function