Access 終了時に最適化する方法 Hit Counter

対象バージョン : 7.0, 95
最終更新日 : 1999/02/03 (オリジナル作成日 : 1998/12/13)


概 要

Access で最適化を行う方法として、メニューの [ツール(T)] - [データベースユーティリティ(D)...] - [最適化(C)] があり、これを SendKeys ステートメントで実現できます。

SendKeys "%TDC"

ただし、この方法では、確実な動作が期待できません。

このため、次の手順により、最適化を行うようにします。

1.Access を起動して他の mdb ファイルを開き、呼び出し側は終了します。
2.呼び出された側で、呼び出した mdb を最適化して終了します。

 

解 説

1.呼び出される側の mdb の作成

(1) モジュールの作成

《宣言》

' 一時ファイル名取得用 API の宣言
Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
    (ByVal lpszPath As String, ByVal lpPrefixString As String, _
    ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

《プロシージャ》

' 一時ファイル名の取得
Public Function udGetTempFileName(argPath) As String
Dim lngRet As Long
Dim strFileName As String * 255

lngRet = GetTempFileName(argPath, "acc", 0&, strFileName)

udGetTempFileName = Left(strFileName, InStr(strFileName, vbNullChar) - 1)
End Function

' フルパス名からディレクトリ名(フォルダ名)の取得
Public Function udGetFolderName(argPath) As String
Dim lngPos As Long
For lngPos = Len(argPath) To 1 Step -1
    If Mid(argPath, lngPos, 1) = "\" Then
        udGetFolderName = Left(argPath, lngPos)
        Exit Function
    End If
Next
End Function

 

(2) フォームの作成

フォームのプロパティ "タイマ間隔" に 3000 を設定。
この値は、呼び出し側の Access を終了するまでの時間稼ぎに使用します。適宜変更してください。

フォームのプロパティ "タイマ時" にイベントプロシージャを作成。

Private Sub Form_Timer()
Dim strSrcDB As String
Dim strDstDB As String
Dim lngRet As Long

On Error GoTo Form_Timer_Err

strSrcDB = Command

If strSrcDB = "" Then ' この mdb を直接開いた場合の判断
    Me.TimerInterval = 0
    DoCmd.Close
    Exit Sub
End If

strDstDB = udGetTempFileName(udGetFolderName(strSrcDB))
' Windows API GetTempFileName はファイルを作成するため削除
Kill strDstDB
DoEvents ' 念のため入れてあります
DBEngine.CompactDatabase strSrcDB, strDstDB
Kill strSrcDB ' 最適化前の mdb ファイルの保存が必要であれば、Name で変更
Name strDstDB As strSrcDB
'【注1】 元の mdb ファイルを開きなおす場合
' DoEvents
' lngRet = Shell(strSrcDB) 
DoCmd.Quit
Exit Sub

Form_Timer_Err:
If Err.Number = 3054 Or Err.Number = 3356 Then ' 【注2】再実行するエラーコード
    If MsgBox(strSrcDB & " は使用中です。" & 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

 

(3) マクロの作成

上記 (2) で作成したフォームを開くマクロを作成し、"AutoExec"(ダブルクオーテーションは不要)という名前で保存します。

 

2.呼び出し側での終了の方法

次のようなプロシージャで終了します。

Dim strPath As String
Dim lngRet As Long

strPath = SysCmd(acSysCmdAccessDir) & "msaccess.exe "
strPath = strPath & "上記 1 で作成した mdb ファイルのフルパス名"
strPath = strPath & " /cmd" & CurrentDb.Name
lngRet = Shell(strPath, vbMinimizedFocus)
DoCmd.Quit

 

補 足

 

改訂履歴

99/02/03 変数名訂正 srcDB → strSrcDB


目次へ戻る