ExcelからAccessデータベースの最適化をする
Accessのデータベースって、テーブルデータを削除、追記、追加などしていく内に、どんどんファイルサイズが大きくなっていきますよね
そのまま放置しているとだんだんモッサリ感でてきませんか？
また、Accessでデータベースを開いて最適化する・・・って面倒だし、つい忘れてしまうことってありますよね
この部屋では、ExcelからAccessのデータベースを最適化する処理をサブルーチン化して掲載していますよ！！
別部屋「404号室:Accessデータベースのテーブル情報を削除」などを行った後にこのサブルーチンを実行するとスムーズかなと思います（Kappo談）
また、一番したの方にコメント欄があるからよかったら質問・感想などメッセージ入れてください。
Accessでテーブルを作成する
※テーブルの作成は 「VBA:Accessデータベースの情報を取得ー別部屋」を参照してください
プログラム（例）
データベース（Access）の準備が出来たので取得のプログラムを記述します
コマンドボタンがクリックされた時に実行されるプログラム
「CommandButton10」
※「VBA:Accessデータベースの情報を取得」で作成したプログラムの「接続後の処理プログラム」の箇所を変更します
Accessデータベースを最適化するサブルーチン
最適化するサブルーチン
・引数：mdbFolder＝データベースのフォルダ
mdbName = データベース名
・戻り値：正常終了＝True
異常終了＝False
最適化の手順
①データベースを別名で最適化
②元データベースを別名にしてバックアップ（リネーム）
③最適化したデータベースを元名にリネーム
▼プログラム▼
'----------------------------------------------------------------------------------------
Function MdbOptimization(mdbFolder As String, mdbName As String)
Dim ret As Boolean
ret = True
'--------------------------------------------
' データベースを最適化する
On Error GoTo DB_Err 'エラー発生時のジャンプ先
'--------------------------------------------
' ファイル名を作る
Dim buf
buf = Split(mdbNmae, ",") 'データベース名の取得（拡張子とわける）
Dim afterName As String '最適化後のファイル名
afterName = buf(0) & "_after." & buf(1)
Dim backupName As String 'バックアップ用ファイル名（念の為）
afterName = buf(0) & "_backup." & buf(1)
'--------------------------------------------
' データベースを最適化する
'
DBEngine.CompactDatabase mdbFolder & mdbName, mdbFolder & afterName
'--------------------------------------------
'バックアップする
'前回のBackupファイルがあった場合前のファイルは削除する
If Dir(mdbFolder & badkupName) <> "" Then '有り無しを確認
Kill mdbFolder & backupName '有った場合ファイル削除
End If
'最適元をファイル名を変更してBackupとして保存（リネーム）
Name mdbFolder & mdbName As mdbFolder & backupName
'--------------------------------------------
' 最適化後のファイルの名前を元に戻します。
Name mdbFolder & afterName As mdbFolder & mdbName
'--------------------------------------------
ret = True
GoTo DB_End
DB_Err:
ret = False
Resume DB_End
DB_End:
'--------------------------------------------
MdbOptimization = ret
'--------------------------------------------
End Function
最適化を呼び出すプログラム（例：「CommandButton10」）
▼プログラム▼
'----------------------------------------------------------------------------------------
Private Sub CommandButton10_Click()
Dim mdbFolder As String 'データベースのフォルダ
Dim mdbName As String 'データベース名
'--------------------------------------------
mdbFolder = Worksheets("Sheet1").Cells(28, 3)
mdbName = Worksheets("Sheet1").Cells(29, 3)
'--------------------------------------------
Dim ret As Boolean
ret = MdbOptimization(mdbolder, mdbName)
If ret = True Then
Call MsgBox("最適化が終了しました。", vbInformation + vbOKOnly, "メッセージ")
Else
Call MsgBox("最適化中にエラーが発生しました。", vbExclamation + vbOKOnly, "メッセージ")
End If
'--------------------------------------------
End Sub
プログラムの実行
※Accessデータベースの元ファイル
①データベースを別名で最適化
②元データベースを別名でバックアップ（リネーム）
③最適化したデータベースを元名にリネーム
コメント