SQL Server接続のAccessをローカルテーブルに移行する

**Microsoft Access** で動くアプリケーションの**アップサイジング** … つまり、ローカルデータベースからSQL Serverに移行する案件はよくあるが、その逆、SQL Serverからローカルデータベースに移行するケースは珍しい。
大抵は、サーバを立てるのが許可されなかったり、ネットワークの都合だったりする。今回そのような稀有な案件に対応したので、コードレベルで対処方法を解説していく。

## まずは予備知識
Accessで業務アプリケーションを作成するときは、次の A～C のパターンいずれかの構成になる。

### 【パターンA】Accessファイル単体で構成
テーブルを含む全てのオブジェクトがひとつのファイルに収まったシンプルな構成である。
主にひとりで使うとき向け。小規模用。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/236222/8e7360e7-2cd9-8454-e949-c19466c73d55.png)
ポータブル（持ち運び可能）で、USBメモリなどからでもそのまま起動できるので使い易い。
スタンドアローンになるので、ネットワークに接続しなくても運用できる。

### 【パターンB】Accessファイルのデータベースを分割した構成
SQL Serverを立てるまでも無いが、数人でちょっとデータベースを共有したいとき向け。中規模用。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/236222/458513f3-f416-a833-a5f1-8f58146bd215.png)
この構成は、データベースを**バックエンド**（実テーブルのみ）と**フロントエンド**（リンクテーブルとその他オブジェクト）に分割することで実現できる。手順の詳細は「Access　データベースを分割」でググってもらえればと思う。
複数のユーザで共有するなら、バックエンドAccessファイルをファイルサーバに置き、フロントエンドAccessファイルを各クライアントPCに配布する、といった使い方になる。
分割すると、パフォーマンスが向上したり、データベースが破損するリスクを軽減できる。新たにサーバを立てなくて済むので、社内の情報システム部門に根回しせずに（エンドユーザ部門だけで）解決できることも多く、殆どのケースで筆者が推奨・ご提案する構成でもある。
また、ファイルサーバは通常、情報システム部門がバックアップの対象としているので、データ保全の観点からも都合が良い。

### 【パターンC】クライアント／サーバの構成
テーブルを SQL Server や MySQL，Oracle，Azure SQL などの**ODBC**対応データベースサーバに置いた構成である。
数十人以上でデータベースを共有したいとき向け。大規模用。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/236222/bc82771f-c773-ac73-95be-40fae8f1eea2.png)
データベースがもっとも壊れにくいパターン。**ADO**や**DAO**を活用して**パススルークエリ**に書き替えることも可能で、そうすることでクエリがデータベースサーバ側で処理されるので高速になる。高信頼／高性能な構成といえよう。

## 移行後の運用フロー
複数のクライアント端末でAccessアプリケーションが動作し、複数のユーザが同時にエントリーするという運用は維持した上で、ネットワーク接続不可という新たな要件も満たす必要があった。
そこで、SQL Serverのテーブルをローカルデータベースに変換し、[【パターンA】Accessファイル単体で構成](#パターンaaccessファイル単体で構成)に寄せた上で、毎日の業務終了後にテーブルを手動で同期させる方法を採った。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/236222/8a754c24-f7ca-dd70-3077-3f32ac0e91bd.png)
要はただのエントリー業務なので、各拠点／各PCで更新されたAccessファイルを１箇所に集め、本部でマージ（結合）した上で、翌朝までに各拠点／各PCに再配布すれば良い。

チーム開発の現場で SVN や Git などの**バージョン管理システム**を使ったことのある人なら、**チェックイン**／**チェックアウト**で考えると理解し易いかもしれない。帰宅前に本部のリモートリポジトリにチェックインし、翌朝ローカルリポジトリにチェックアウトして再び使うイメージである。

移行後の運用フロー **①～④** の作業を人間が毎日やるのは負担が大きいので、以下の通りマクロ化してみた。

なお、**Access VBA** ではなく **Excel VBA** で動かしているので、Accessのシステム定数を最初に定義している。

```vb:ExcelVBA
Const acImport = 0
Const acExport = 1
Const dbSystemObject = -2147483646
```

### ① AccessのテーブルをExcelシートに出力
フォルダ名「入力アクセス」に集められたAccessファイルから、すべてのユーザテーブルをExcelファイルで出力（エクスポート）する。
Excelファイル名は、〝テーブル名〟＋〝元々のAccessファイル名〟になる。

```vb:ExcelVBA
Sub AccessTable2ExcelSheet()
    Dim acApp As Object, acDB As Object, acTD As Object
    Dim sTableName As String, sAccessFile As String, sExcelFile As String, sInFolder As String, sOutFolder As String
    
    ' Accessファイルを入力するフォルダの有無を確認
    sInFolder = ThisWorkbook.Path & "\入力アクセス"
    If Dir(sInFolder, vbDirectory) = "" Then
        MsgBox "入力フォルダが見つかりません", vbCritical
        Exit Sub
    End If
    
    ' テーブルを出力するフォルダの有無を確認
    sOutFolder = ThisWorkbook.Path & "\出力テーブル"
    If Dir(sOutFolder, vbDirectory) = "" Then
        MsgBox "出力先フォルダを作成して下さい", vbCritical
        Exit Sub
    End If
    
    Set acApp = CreateObject("Access.Application")  ' Accessオブジェクトを実行時バインディング
    acApp.Visible = True
    
    ' 入力フォルダにあるすべてのAccessファイルを参照
    sAccessFile = Dir(sInFolder & "\*.accdb")
    Do Until sAccessFile = ""
        acApp.OpenCurrentDatabase sInFolder & "\" & sAccessFile  ' Accessファイルを開く
        Set acDB = acApp.CurrentDb

        ' すべてのテーブルを参照
        For Each acTD In acDB.TableDefs
            If acTD.Attributes And dbSystemObject Then GoTo CONTINUE  ' システムテーブルを除く
            
            sTableName = acTD.Name  ' テーブル名
            sExcelFile = sOutFolder & "\" & sTableName & "_" & Replace(sAccessFile, ".accdb", "") & ".xlsx" ' Excelファイル名
            
            ' テーブルをExcelシートにエクスポート
            acApp.DoCmd.TransferSpreadsheet acExport, , sTableName, sExcelFile, True
CONTINUE:
        Next
        acApp.CloseCurrentDatabase
        sAccessFile = Dir
    Loop
    acApp.Quit
    MsgBox sOutFolder & vbLf & "に出力しました", vbInformation
End Sub
```

Accessの終了を`acApp.Quit`でやっているが、次行の`MsgBox`がAccessの裏に隠れる場合は`acApp.DoCmd.Quit`を試して欲しい。

### ② 同じテーブル同士のExcelファイルを単純結合
テーブルが同じファイル同士をひとつに結合し、フォルダ名「マージ」に出力する。
出力されるExcelファイル名は、テーブル名と同じ。

```vb:ExcelVBA
Sub ConcatenateExcelSheet()
    Dim aryList As Object
    Dim sTableName As String, sExcelFile As String, sInFolder As String, sOutFolder As String
    Dim v As Variant, sCtrlBreakKey As String, nRow As Long
    Dim wbIn As Workbook, wbOut As Workbook
    
    sInFolder = ThisWorkbook.Path & "\出力テーブル"
    If Dir(sInFolder, vbDirectory) = "" Then
        MsgBox "入力フォルダが見つかりません", vbCritical
        Exit Sub
    End If
    
    sOutFolder = ThisWorkbook.Path & "\マージ"
    If Dir(sOutFolder, vbDirectory) = "" Then
        MsgBox "出力先フォルダを作成して下さい", vbCritical
        Exit Sub
    End If
    
    ' .NET Framework の ArrayList にファイル名を格納
    Set aryList = CreateObject("System.Collections.ArrayList")
    sExcelFile = Dir(sInFolder & "\*.xlsx")
    Do Until sExcelFile = ""
        aryList.Add sExcelFile
        sExcelFile = Dir
    Loop
    aryList.Sort  ' ソート
    
    sCtrlBreakKey = ""  ' コントロールブレイクキーのクリア
    
    ' ファイル名の順で読む
    For Each v In aryList
        Set wbIn = Workbooks.Open(sInFolder & "\" & v)  ' Excelファイルを開く
        sTableName = Split(v, "_")(0)  ' アンダーバーで分割した最初の要素を取得
        
        If sCtrlBreakKey <> sTableName Then
            Call controlBreak(sCtrlBreakKey, wbOut, sOutFolder & "\" & sCtrlBreakKey)
            Set wbOut = Workbooks.Add
            sCtrlBreakKey = sTableName
        End If
        
        With wbOut.Sheets(1).UsedRange
            nRow = 1 + .Rows(.Rows.Count).Row  ' 出力シートの最終行を取得
        End With
        
        wbIn.Sheets(1).UsedRange.Copy wbOut.Sheets(1).Cells(nRow, 1)  ' コピー
        If nRow > 2 Then
            wbOut.Sheets(1).Rows(nRow).Delete  ' 余分なヘッダーを削除
        Else
            wbOut.Sheets(1).Rows(1).Delete  ' 先頭の空行を削除
        End If
        wbIn.Close False
CONTINUE:
    Next
    Call controlBreak(sCtrlBreakKey, wbOut, sOutFolder & "\" & sCtrlBreakKey)
    MsgBox sOutFolder & vbLf & "に出力しました", vbInformation
End Sub

' コントロールブレイク処理
Private Sub controlBreak(sKey As String, wb As Workbook, sSaveFileName As String)
    If sKey = "" Then Exit Sub

    wb.Sheets(1).Columns.AutoFit
    Application.DisplayAlerts = False  ' 警告オフ
    wb.Close True, sSaveFileName
    Application.DisplayAlerts = True   ' 警告オン
End Sub
```

ソースコードのコメントにある**コントロールブレイク**という用語についても簡単に解説しておこう。
昨今ではあまり聞き慣れないが、ソートされたキー項目（ここではファイル名に含まれるテーブル名）が前回と変わったときを指す古いIT用語で**キーブレイク**とも呼ばれる。一般に、集計処理や帳票の改頁処理で使われるが、ここでは同じテーブル同士をグルーピングするために使っている。

### ③ マージ
重複を排除したり、コンフリクト（競合）を解消したりする。バージョン管理システムの利用者にとっては**マージ**と同じ概念と思ってもらって構わない。
ここの処理はビジネスロジック（システム固有の処理）になるのでコードは割愛させていただく。
なお、ここでExcelファイルにしたのは、事務屋さんでも手修正を容易にするためだ。

### ④ ExcelファイルをAccessテーブルに戻す
統合したExcelファイルを、マクロと同じフォルダにあるAccessファイルのテーブルにインポートする。

```vb:ExcelVBA
Sub Excel2AccessTable()
    Dim acApp As Object
    Dim sAccessFile As String, sOutFolder As String
    
    sOutFolder = ThisWorkbook.Path & "\マージ"
    sAccessFile = ThisWorkbook.Path & "\" & Dir(ThisWorkbook.Path & "\*.accdb")
    
    Set acApp = CreateObject("Access.Application")  ' Accessオブジェクトを実行時バインディング
    acApp.Visible = True
    
    acApp.OpenCurrentDatabase sAccessFile  ' Accessファイルを開く
    
    Call clearTable("テーブルA", acApp, sOutFolder)
    Call clearTable("テーブルB", acApp, sOutFolder)
    
    acApp.CloseCurrentDatabase
    acApp.Quit
    MsgBox sAccessFile & vbLf & "にインポートしました", vbInformation
End Sub

' 対象のテーブルをクリアしてからインポート
Private Sub clearTable(sTableName As String, app As Object, sFolder As String)
    app.DoCmd.SetWarnings False  ' 警告オフ
    app.DoCmd.RunSQL "DELETE * FROM " & sTableName  ' Access の SQL に TRUNCATE TABLE は無い！
    app.DoCmd.SetWarnings True   ' 警告オン
    app.DoCmd.TransferSpreadsheet acImport, , sTableName, sFolder & "\" & sTableName & ".xlsx", True
End Sub
```

### （追記）Accessファイルを連番付きでコピー
各拠点／各PCに翌朝から使うAccessファイルをコピーする処理を追加した。
コピーされるファイル名には連番と翌日日付を入れている。

```vb:ExcelVBA
Sub AccessFileDuplication()
    Dim sAccessFile As String, sOutFolder As String, sFile As String, i As Integer
    
    sAccessFile = ThisWorkbook.Path & "\" & Dir(ThisWorkbook.Path & "\*.accdb")
    
    sOutFolder = ThisWorkbook.Path & "\配布用"
    If Dir(sOutFolder, vbDirectory) = "" Then MkDir sOutFolder  ' 配布用フォルダが無ければ作成
    On Error Resume Next
    Kill sOutFolder & "\*.accdb"  ' 配布用フォルダを空っぽにする
    On Error GoTo 0
    
    sFile = Mid(sAccessFile, InStrRev(sAccessFile, "\") + 1)  ' basename
    sFile = Left(sFile, InStrRev(sFile, ".") - 1)  ' 拡張子を除く
    
    For i = 1 To 20
        FileCopy sAccessFile, sOutFolder & "\" & Format(i, "00_") & sFile & Format(DateAdd("d", 1, Now), "_yyyymmdd") & ".accdb"
    Next
    
    MsgBox sOutFolder & vbLf & "にコピーしました", vbInformation
End Sub
```

以上、少しでも参考になれば幸いである。