Accessの最適化修復時の問題に対応する為に作った自作ツール

# Accessの最適化修復時の問題

**レコードが無い** テーブルの **オートナンバー型** の採番が **1からスタートにリセット** されてしまう。

https://qiita.com/waokitsune/items/82e03876b0c729fea0d4

# 手で対応はスーパーウルトラミラクル面倒

1. テーブルを一つ一つ **手で** 開いて、レコードの有無確認…。
1. レコードが0なら **手で** ダミーレコード挿入…。
1. 最適化修復し終わったら挿入したダミーレコードを **手で** 消していく…。（テーブルを一つ一つ **手で** 開いて…）

こんなこと、 **とてもじゃないけどやりたくない** のでツール作りました。
手でやると間違えるしね…。


# 自作ツールの概要

主に2つのことを行います。

1. 最適化修復対象Accessを開き、レコードが無いテーブルにダミーレコードをインサート。
（**最適化修復前の下処理**）
1. 最適化修復をしたAccessを開き、ダミーレコードをインサートしたテーブルのレコード全削除。
（**最適化修復後の切り戻し**）

# 自作ツールの中身

## Accessで実装

ざっくり言うと **外部Accessファイルを操作するAccess** です。

オブジェクトは下記3つ
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/706116/51eed899-4891-e80f-e520-20af2a9dbde6.png)

参照設定は下記。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/706116/274bdf56-40e5-97eb-e31d-33e47cb8c85b.png)


## no_record_table

**どのテーブルにダミーレコードを挿入したか** の情報を持っておく器が主な役割です。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/706116/c65a686b-7a26-c211-3203-b0845ee6ea80.png)

* ダミーレコードが挿入できなかったテーブル洗い出し
* テーブルのレコード全削除が問題無く行えたかの結果保持

としての役割もあります。

## q_dummy

各種処理結果などを表示する為だけのダミークエリです。

## root

ボタンが2つだけのフォーム。
ボタンは上から『btn_before_optimize』『btn_after_optimize』という名前。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/706116/3ab02d89-e07d-7258-241b-a4be11e130c4.png)

### ソースコード

```vb
Option Compare Database
Option Explicit


Private FILE_PATH_ As String


Private Sub btn_before_optimize_Click()
    
    
    '---------------------------------------------------------------------------------------------
    Dim sql_ As String
    Dim com_ As New ADODB.Command: com_.ActiveConnection = CurrentProject.Connection
    
    
    '---------------------------------------------------------------------------------------------
    '■ファイル選択
    Dim file_select_ As Long
    
    With Application.FileDialog(msoFileDialogOpen)
    
        .title = "ファイル選択"
        .Filters.Clear
        .Filters.Add "accdb", "*.accdb"
        .Filters.Add "mdb", "*.mdb"
        .FilterIndex = 1
        .AllowMultiSelect = False
        .InitialFileName = CurrentProject.Path & "\"
        
        file_select_ = .Show 'ダイアログを表示
        
        If file_select_ <> 0 Then
        
            FILE_PATH_ = Trim(.SelectedItems.Item(1))
            
        Else
            Exit Sub
        End If
        
    End With
    

    '---------------------------------------------------------------------------------------------
    If MsgBox(FILE_PATH_ & vbCrLf & vbCrLf & "実行OK？", vbYesNo + vbDefaultButton2, "確認") = vbNo Then
        Exit Sub
    End If
    
    
    '---------------------------------------------------------------------------------------------
    '■ファイルバックアップ
    
    Dim fso_ As New Scripting.FileSystemObject
    
    Dim backup_folder_path_ As String
    backup_folder_path_ = CurrentProject.Path & "\Backup_" & Format(Now(), "yyyymmdd_hhnn") & "\"
    Call fso_.CreateFolder(backup_folder_path_)
    Call fso_.CopyFile(FILE_PATH_, backup_folder_path_)
    
    
    '---------------------------------------------------------------------------------------------
    '■レコード0テーブル情報クリア
    com_.CommandText = "DELETE FROM no_record_table ;"
    com_.Execute
    
    
    '---------------------------------------------------------------------------------------------
    '■最適化対象Accessファイル開く
    Dim access_obj_ As New Access.Application
    access_obj_.OpenCurrentDatabase FILE_PATH_, True
    
    
    '---------------------------------------------------------------------------------------------
    '■最適化対象Accessファイル内のテーブル一覧ループ
    Dim obj_ As Object
    For Each obj_ In access_obj_.CurrentData.AllTables
        
        
        Select Case obj_.Attributes
        
            'システム情報やリンクテーブルのデータは除外
            Case 10, -2147483648#, 262154, 2, 2097152, 2097152, 537919488
                Debug.Print "対象外: " & obj_.Name
            
            Case Else
                
                If access_obj_.DCount("*", "[" & obj_.Name & "]") <> 0 Then
                
                    Debug.Print "対象外（レコードあり）: " & obj_.Name
                
                Else
                    
                    'レコード0テーブル情報にインサート
                    com_.CommandText = "INSERT INTO no_record_table (table_name) VALUES (@table_name) "
                    com_.NamedParameters = True
                    com_.Parameters("@table_name") = obj_.Name
                    com_.Execute
                    
                    'テーブルのカラムループして文字列系カラムあったらダミーレコードをインサート
                    Dim dbs_ As DAO.Database: Set dbs_ = access_obj_.CurrentDb
                    Dim tdf_ As DAO.TableDef: Set tdf_ = dbs_.TableDefs(obj_.Name)
                    
                    Dim fld_ As DAO.Field
                    For Each fld_ In tdf_.Fields
                        If fld_.Type = dbText Then
                            access_obj_.DoCmd.SetWarnings False
                            access_obj_.DoCmd.RunSQL "INSERT INTO " & obj_.Name & " ([" & fld_.Name & "]) SELECT 1 "
                            access_obj_.DoCmd.SetWarnings True
                            Exit For
                        End If
                    Next
                    
                    'ダミーレコードインサート結果を保持
                    sql_ = "UPDATE no_record_table SET record_count_after_dummy_insert = @count "
                    sql_ = sql_ & "WHERE table_name = @table_name "
                    com_.CommandText = sql_
                    com_.NamedParameters = True
                    com_.Parameters("@count") = access_obj_.DCount("*", obj_.Name)
                    com_.Parameters("@table_name") = obj_.Name
                    com_.Execute
                
                End If
                
        End Select
                
    Next
    
    
    '---------------------------------------------------------------------------------------------
    '■最適化対象Accessファイル閉じる
    access_obj_.Quit
    
    
    '---------------------------------------------------------------------------------------------
    '■ダミーレコードインサートできなかったテーブル確認
    '文字列系カラムが1つもないテーブルに対しては、このツールからダミーレコードをインサートできない。
    'そういったテーブルは仕方ないので表示した内容を参考に手動でダミーレコードをインサート。
    sql_ = "SELECT * FROM no_record_table WHERE record_count_after_dummy_insert = 0 "
    CurrentDb.QueryDefs("q_dummy").sql = sql_
    DoCmd.OpenQuery "q_dummy", acViewNormal, acReadOnly
    
    
    '---------------------------------------------------------------------------------------------
    MsgBox "処理終了", vbInformation, "通知"
    
    
End Sub



Private Sub btn_after_optimize_Click()
    

    '---------------------------------------------------------------------------------------------
    If MsgBox(FILE_PATH_ & vbCrLf & vbCrLf & "実行OK？", vbYesNo + vbDefaultButton2, "確認") = vbNo Then
        Exit Sub
    End If
    
    
    '---------------------------------------------------------------------------------------------
    '■最適化対象Accessファイル開く
    Dim access_obj_ As New Access.Application
    access_obj_.OpenCurrentDatabase FILE_PATH_, True
    
    
    '---------------------------------------------------------------------------------------------
    '■ツール側で最適化前に控えておいた『レコード無しテーブル一覧』をループ
    Dim sql_ As String
    Dim com_ As New ADODB.Command: com_.ActiveConnection = CurrentProject.Connection
    
    Dim rst_ As New ADODB.Recordset
    rst_.Open _
        "no_record_table", _
        CurrentProject.Connection, _
        adOpenForwardOnly, _
        adLockReadOnly
    Do Until rst_.EOF

        'レコード削除実行
        access_obj_.DoCmd.SetWarnings False
        access_obj_.DoCmd.RunSQL "DELETE FROM [" & rst_.Fields("table_name") & "] "
        access_obj_.DoCmd.SetWarnings True
        
        '念の為レコード削除結果保持
        sql_ = "UPDATE no_record_table SET record_count_after_delete = @count "
        sql_ = sql_ & "WHERE table_name = @table_name "
        com_.CommandText = sql_
        com_.NamedParameters = True
        com_.Parameters("@count") = access_obj_.DCount("*", "[" & rst_.Fields("table_name") & "]")
        com_.Parameters("@table_name") = rst_.Fields("table_name")
        com_.Execute

    rst_.MoveNext: Loop
    rst_.Close
    
    
    '---------------------------------------------------------------------------------------------
    '■最適化対象Accessファイル閉じる
    access_obj_.Quit
    
    
    '---------------------------------------------------------------------------------------------
    '■レコード削除結果確認
    sql_ = "SELECT * FROM no_record_table WHERE record_count_after_delete <> 0 "
    CurrentDb.QueryDefs("q_dummy").sql = sql_
    DoCmd.OpenQuery "q_dummy", acViewNormal, acReadOnly
    
    
    '---------------------------------------------------------------------------------------------
    MsgBox "処理終了", vbInformation, "通知"
    
    
End Sub
```

# ポイント

## 外部Access操作

下記のようにインスタンスすると外部Accessを操作できる。
```vb
Dim access_obj_ As New Access.Application
access_obj_.OpenCurrentDatabase "外部Accessのファイルパス", True
```

↓外部Accessに対してSQL実行したり…
```access_obj_.DoCmd.RunSQL "SQL文"```

↓外部Accessのレコード数とったり…
```access_obj_.DCount("*", "[テーブル名]")```

## バックアップ

外部Accessに一時的にではあるが副作用を起こすので、処理前にバックアップとる。

## ダミーレコードをインサートできないテーブルもある

頑張ればできるかもしれないが、コードが複雑になるのでやめた。
インサートできなかったテーブル一覧が表示されるようにして、それらは手動対応とする方針にした。

**『全てを自動化する』** のが目的ではなく、 **『手による処理が大幅に減る』** ことが目的なのでこれでよいという判断。

# バージョン

Windows 10 Pro 21H2 OSビルド 19044.2130
 Microsoft Access for Microsoft 365 MSO (バージョン 2209 ビルド 16.0.15629.20196) 32 ビット