Microsoft Access で動くアプリケーションのアップサイジング … つまり、ローカルデータベースからSQL Serverに移行する案件はよくあるが、その逆、SQL Serverからローカルデータベースに移行するケースは珍しい。
大抵は、サーバを立てるのが許可されなかったり、ネットワークの都合だったりする。今回そのような稀有な案件に対応したので、コードレベルで対処方法を解説していく。
まずは予備知識
Accessで業務アプリケーションを作成するときは、次の A～C のパターンいずれかの構成になる。
【パターンA】Accessファイル単体で構成
テーブルを含む全てのオブジェクトがひとつのファイルに収まったシンプルな構成である。
主にひとりで使うとき向け。小規模用。
ポータブル（持ち運び可能）で、USBメモリなどからでもそのまま起動できるので使い易い。
スタンドアローンになるので、ネットワークに接続しなくても運用できる。
【パターンB】Accessファイルのデータベースを分割した構成
SQL Serverを立てるまでも無いが、数人でちょっとデータベースを共有したいとき向け。中規模用。
この構成は、データベースをバックエンド（実テーブルのみ）とフロントエンド（リンクテーブルとその他オブジェクト）に分割することで実現できる。手順の詳細は「Access データベースを分割」でググってもらえればと思う。
複数のユーザで共有するなら、バックエンドAccessファイルをファイルサーバに置き、フロントエンドAccessファイルを各クライアントPCに配布する、といった使い方になる。
分割すると、パフォーマンスが向上したり、データベースが破損するリスクを軽減できる。新たにサーバを立てなくて済むので、社内の情報システム部門に根回しせずに（エンドユーザ部門だけで）解決できることも多く、殆どのケースで筆者が推奨・ご提案する構成でもある。
また、ファイルサーバは通常、情報システム部門がバックアップの対象としているので、データ保全の観点からも都合が良い。
【パターンC】クライアント／サーバの構成
テーブルを SQL Server や MySQL，Oracle，Azure SQL などのODBC対応データベースサーバに置いた構成である。
数十人以上でデータベースを共有したいとき向け。大規模用。
データベースがもっとも壊れにくいパターン。ADOやDAOを活用してパススルークエリに書き替えることも可能で、そうすることでクエリがデータベースサーバ側で処理されるので高速になる。高信頼／高性能な構成といえよう。
移行後の運用フロー
複数のクライアント端末でAccessアプリケーションが動作し、複数のユーザが同時にエントリーするという運用は維持した上で、ネットワーク接続不可という新たな要件も満たす必要があった。
そこで、SQL Serverのテーブルをローカルデータベースに変換し、【パターンA】Accessファイル単体で構成に寄せた上で、毎日の業務終了後にテーブルを手動で同期させる方法を採った。
要はただのエントリー業務なので、各拠点／各PCで更新されたAccessファイルを１箇所に集め、本部でマージ（結合）した上で、翌朝までに各拠点／各PCに再配布すれば良い。
チーム開発の現場で SVN や Git などのバージョン管理システムを使ったことのある人なら、チェックイン／チェックアウトで考えると理解し易いかもしれない。帰宅前に本部のリモートリポジトリにチェックインし、翌朝ローカルリポジトリにチェックアウトして再び使うイメージである。
移行後の運用フロー ①～④ の作業を人間が毎日やるのは負担が大きいので、以下の通りマクロ化してみた。
なお、Access VBA ではなく Excel VBA で動かしているので、Accessのシステム定数を最初に定義している。
Const acImport = 0
Const acExport = 1
Const dbSystemObject = -2147483646
① AccessのテーブルをExcelシートに出力
フォルダ名「入力アクセス」に集められたAccessファイルから、すべてのユーザテーブルをExcelファイルで出力（エクスポート）する。
Excelファイル名は、〝テーブル名〟＋〝元々のAccessファイル名〟になる。
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ファイル名は、テーブル名と同じ。
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ファイルのテーブルにインポートする。
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ファイルをコピーする処理を追加した。
コピーされるファイル名には連番と翌日日付を入れている。
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
以上、少しでも参考になれば幸いである。