キャッシュをJSONファイルに保存して、Excelを閉じても再利用できるバージョン
これまでの「DB定義をキャッシュ」では、Excelを閉じるとキャッシュが消えてしまいました。
ここでは キャッシュをJSONファイルに保存 しておき、次回Excelを開いたときに再利用できる仕組みを作ります。
キャッシュの仕組み
- 初回実行時
- DBから定義を取得
- JSONファイルに保存（例：
FieldDefCache.json） - メモリにもキャッシュ
- 次回以降
- JSONファイルが存在すればそれを読み込む
- DB接続は不要
- 定義更新時
- キャッシュをクリアして再取得 → JSONを上書き
VBAコード例
Option Explicit
Private g_FieldDefs As Collection ' メモリキャッシュ
Private Const CACHE_FILE As String = "FieldDefCache.json"
' --- 定義を取得（JSONキャッシュ優先） ---
Function GetFieldDefinitions() As Collection
If g_FieldDefs Is Nothing Then
' JSONキャッシュがあれば読み込み
If Dir(ThisWorkbook.Path & "\" & CACHE_FILE) <> "" Then
Set g_FieldDefs = LoadDefsFromJSON(ThisWorkbook.Path & "\" & CACHE_FILE)
End If
' なければDBから取得して保存
If g_FieldDefs Is Nothing Then
Set g_FieldDefs = LoadDefsFromDB()
SaveDefsToJSON g_FieldDefs, ThisWorkbook.Path & "\" & CACHE_FILE
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 = "["
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) ' Unicode
ts.Write json
ts.Close
End Sub
' --- JSONから読み込み ---
Function LoadDefsFromJSON(filePath As String) 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をパース（要: Microsoft Scripting Runtime + JSONライブラリ）
' 例: VBA JSON (https://github.com/VBA-tools/VBA-JSON)
Set json = JsonConverter.ParseJson(text)
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
ポイント
- 初回はDB → JSON保存
- 次回以降はJSONからロード
- VBA-JSONライブラリ（VBA-tools/VBA-JSON）を利用してパース
- ClearFieldDefCache でキャッシュを削除し、再取得可能
応用アイデア
- JSONに「更新日時」を入れて、一定期間経過したら自動で再取得。
- JSONをネットワーク共有フォルダに置いて、複数ユーザーで共通利用。
- JSONを暗号化してセキュリティを強化。
👉 これで Excelを閉じてもキャッシュが残り、次回起動時に即利用可能 になります。
