Access ： データベースの最適化

Option Compare Database

'ファイル選択ダイアログ
Public Function SelectFile_FileDialog() As String
    Dim dlgfolder As FileDialog
    'ダイアログのタイトル
    Application.FileDialog(msoFileDialogFilePicker).Title = "ファイルを選択してください"
    '初期のフォルダ
    Application.FileDialog(msoFileDialogFilePicker).InitialFileName = "c:\"
    'フィルターをアクセスファイル（ACCDBかMDBファイル）にする
    Application.FileDialog(msoFileDialogFilePicker).Filters.Clear
    Application.FileDialog(msoFileDialogFilePicker).Filters.Add "ｱｸｾｽﾌｧｲﾙ", "*.accdb;*.mdb", 1
    '一つのファイルのみ選択可能
    Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogFilePicker).show = -1 Then
        'ファイルが選択された
        SelectFile_FileDialog = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    Else
        SelectFile_FileDialog = ""
    End If
End Function

Private Sub コマンド0_Click()
    Dim sfina As String
    Dim beforesize As Long
    Dim aftersize As Long
    Dim wkfina As String
    sfina = SelectFile_FileDialog
    If sfina = "" Then
        Exit Sub
    End If
    '最適化前のサイズ
    beforesize = FileLen(sfina)
        '最適化されるファイル名の作成
    If Right(sfina, 3) = "cdb" Then
        'Access2007の場合
        wkfina = Left(sfina, Len(sfina) - 6)
        wkfina = wkfina + "temp.accdb"
    Else
        wkfina = Left(sfina, Len(sfina) - 4)
        wkfina = wkfina + "temp.mdb"
    End If
    'データベースの最適化
    DBEngine.CompactDatabase sfina, wkfina
    '最適化済みファイルに書き換える
    Kill sfina
    Name wkfina As sfina
    '最適化後のサイズ
    aftersize = FileLen(sfina)

    Me!テキスト1 = "最適化前サイズ： " & beforesize & vbNewLine
    Me!テキスト1 = Me!テキスト1 & "最適化後サイズ： " & aftersize
End Sub