• バックエンド用のデータベース。　テーブルのみを格納したものです。
• フロントエンド用データベース。　テーブル以外の全てのものを格納してあります。
  通常はこのフロントエンドデータベースを開いて一連の作業を行います。
• 最適化用のデータベース。これが一番重要です。

Private Sub cmd終了_Click()
' システム終了時 Access も終了する      2002/01/06 pPoy
On Error GoTo Err_cmd終了_Click
    
    ' 終了時にバックエンドを最適化。
    Dim strPath As String
    Dim varRet As Variant
    Dim strMydb As String       ' 最適化実行mdb
    Dim strLetdb As String      ' 最適化対象mdb
    
    MsgBox "Access終了時にシステムの最適化を行います。" & vbCrLf & _
            "バックグラウンドで作業を行います。" & vbCrLf & vbCrLf & _
            "すべて終了するまで、３０秒位 はパソコンの電源を切らないでください。", vbOKOnly
    
    DoCmd.Close acForm, Me.Name, acSaveYes
    
    ' 最適化実行mdbのフルパス
    ' この「最適化M.mdb」は、間違って削除されないように、
    '予めAccessのシステムと同じフォルダに入れておきます。
    strMydb = SysCmd(acSysCmdAccessDir) & "最適化M.mdb"              
    
    ' リンク元のフルパス格納(システムテーブルから読みます)
    strLetdb = DLookup("database", "msysobjects", "type=6")         
    strPath = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
    strPath = strPath & Space$(1) & Chr$(34) & strMydb & Chr$(34) & Space$(1) & _
                "/cmd " & Chr$(34) & strLetdb & Chr$(34)
    
    ' Accessを　/cmd　付きで呼び出します。このときの処理は最小化したまま実行します。
    varRet = Shell(strPath, vbMinimizedFocus)

    DoCmd.Quit	' Accessを終了します。

Exit_cmd終了_Click:
    Exit Sub

Err_cmd終了_Click:
    MsgBox Err.Description
    Resume Exit_cmd終了_Click
End Sub

Private Sub Form_Load()
    ' 呼び出し元の終了までの時間稼ぎ
    Me.TimerInterval = 3000         '3秒

End Sub




Private Sub Form_Timer()
' 「db1_fe.mdb」から呼び出されたときのみ、「db1_be.mdb」を最適化する。

    Dim strMibeDB As String         ' 最適化元のdb
    Dim strKariDB As String         ' 仮のdb

On Error GoTo Form_Timer_Err

    'strMibeDB = ' 最適化したいdbのフルパス+コマンドライン
    strMibeDB = Command

    ' このdbを直接開いた場合、そのまま終了
    If strMibeDB = "" Then
        Me.TimerInterval = 0
        DoCmd.Close
        Exit Sub
    End If

    strKariDB = "C:\My Documents\仮db.mdb"                         ' 仮dbのフルパス

    ' 仮dbを削除
    subFileDel (strKariDB)
    DoEvents

    ' 最適化
    DBEngine.CompactDatabase strMibeDB, strKariDB

    ' 仮dbを元dbにコピーし、仮dbを削除
    subFileDel (strMibeDB)
    FileCopy strKariDB, strMibeDB
    subFileDel (strKariDB)

    DoCmd.Quit
    Exit Sub

Form_Timer_Err:
    If Err.Number = 3054 Or Err.Number = 3356 Then
        If MsgBox(strMibeDB & " は、使用中です。" & vbCrLf & vbCrLf & _
            "最適化を中止しますか？", vbExclamation + vbYesNo) = vbYes Then
            DoCmd.Quit
        End If
    Else
        MsgBox "実行時エラー'" & Err.Number & "': " & vbCrLf & vbCrLf & _
            Err.Description, vbCritical
    End If
    Exit Sub

End Sub




Public Sub subFileDel(str As String)
' ファイル削除用のサブルーチン
On Error GoTo subFileDel_Err        ' 削除するファイルが無い場合、何もしない

    Kill str
    Exit Sub

subFileDel_Err:
    Exit Sub
    Resume

End Sub