キャッシュの有効期限を設定して、古くなったら自動で再取得するバージョン
これまでの「JSONキャッシュ保存」方式をさらに発展させて、キャッシュに有効期限を持たせる仕組みです。
一定期間（例：1日）を過ぎたらキャッシュを無効化し、DBから再取得して更新します。
仕組みの考え方
- JSONキャッシュに「更新日時」を一緒に保存する。
- 読み込み時に現在日時と比較し、期限切れならDBから再取得。
- 再取得したらJSONを上書き保存。
VBAコード例
Option Explicit
Private g_FieldDefs As Collection ' メモリキャッシュ
Private Const CACHE_FILE As String = "FieldDefCache.json"
Private Const CACHE_EXPIRE_DAYS As Long = 1 ' 有効期限（日数）
' --- 定義を取得（キャッシュ優先、期限切れなら再取得） ---
Function GetFieldDefinitions() As Collection
If g_FieldDefs Is Nothing Then
Dim cachePath As String
cachePath = ThisWorkbook.Path & "\" & CACHE_FILE
' JSONキャッシュがあれば読み込み
If Dir(cachePath) <> "" Then
Dim defs As Collection, cacheDate As Date
Set defs = LoadDefsFromJSON(cachePath, cacheDate)
' 有効期限チェック
If Now - cacheDate <= CACHE_EXPIRE_DAYS Then
Set g_FieldDefs = defs
End If
End If
' キャッシュが無効ならDBから再取得
If g_FieldDefs Is Nothing Then
Set g_FieldDefs = LoadDefsFromDB()
SaveDefsToJSON g_FieldDefs, cachePath
End If
End If
Set GetFieldDefinitions = g_FieldDefs
End Function
' --- DBから定義を取得 ---
Function LoadDefsFromDB() As Collection
Dim conn As Object, rs As Object, sql As String, defs As New Collection
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\FieldDef.accdb;"
sql = "SELECT 列番号, 項目名, 必須, 型, 最小値, 最大値, 最大文字数, 正規表現 FROM FieldDefinitions"
Set rs = CreateObject("ADODB.Recordset")
rs.Open sql, conn
Do Until rs.EOF
defs.Add Array(rs(0).Value, rs(1).Value, rs(2).Value, rs(3).Value, _
rs(4).Value, rs(5).Value, rs(6).Value, rs(7).Value)
rs.MoveNext
Loop
rs.Close: conn.Close
Set LoadDefsFromDB = defs
End Function
' --- JSONに保存（更新日時付き） ---
Sub SaveDefsToJSON(defs As Collection, filePath As String)
Dim fso As Object, ts As Object, def As Variant, json As String
Dim i As Long
json = "{""更新日時"":""" & Format(Now, "yyyy-mm-dd hh:nn:ss") & """,""定義"":["
For i = 1 To defs.Count
def = defs(i)
json = json & "{""列番号"":" & def(0) & ",""項目名"":""" & def(1) & """,""必須"":""" & def(2) & """,""型"":""" & def(3) & """,""最小値"":""" & def(4) & """,""最大値"":""" & def(5) & """,""最大文字数"":""" & def(6) & """,""正規表現"":""" & def(7) & """}"
If i < defs.Count Then json = json & ","
Next i
json = json & "]}"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(filePath, True, True)
ts.Write json
ts.Close
End Sub
' --- JSONから読み込み（更新日時も返す） ---
Function LoadDefsFromJSON(filePath As String, ByRef cacheDate As Date) As Collection
Dim fso As Object, ts As Object, text As String
Dim json As Object, item As Variant, defs As New Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(filePath, 1, False, -1)
text = ts.ReadAll
ts.Close
' JSONパース（要: VBA JSONライブラリ）
Set json = JsonConverter.ParseJson(text)
cacheDate = CDate(json("更新日時"))
For Each item In json("定義")
defs.Add Array(item("列番号"), item("項目名"), item("必須"), item("型"), _
item("最小値"), item("最大値"), item("最大文字数"), item("正規表現"))
Next item
Set LoadDefsFromJSON = defs
End Function
' --- キャッシュクリア ---
Sub ClearFieldDefCache()
Set g_FieldDefs = Nothing
If Dir(ThisWorkbook.Path & "\" & CACHE_FILE) <> "" Then
Kill ThisWorkbook.Path & "\" & CACHE_FILE
End If
MsgBox "キャッシュをクリアしました。次回はDBから再取得します。", vbInformation
End Sub
ポイント
- JSONに「更新日時」を保存。
- 読み込み時に
Now - cacheDateを比較して期限切れ判定。 CACHE_EXPIRE_DAYSを変更すれば有効期限を自由に設定可能。- 期限切れならDBから再取得してJSONを更新。
応用アイデア
- 有効期限を「日数」ではなく「分単位」で設定してリアルタイム性を高める。
- DB側に「定義更新日時」カラムを持たせて、それと比較してキャッシュ更新。
- JSONに「バージョン番号」を持たせて、定義変更時に強制更新。
👉 これで キャッシュを永続化しつつ、有効期限で自動更新 できるようになりました。
