ACCESSのVBAでリンクテーブルを更新する

ACCESSでプログラムを作成する際に、プログラム部分とデータベース部分に分ける事が良くあります。

分割することでプログラム修正後の入れ替え作業時にデータベースを誤って上書きしてしまう事を防止できます。

その際にプログラム部分のACCESS側でデータベースのリンクを行う必要がありますが、プログラムやデータベース部分の保存フォルダを変更したりすると、再度リンクし直さなければなりません。

全て自分で設定するときは手動でリンクし直せば良いのですが、利用者にやってもらう場合、たとえ簡単な手順であっても操作を間違ったりするものです。

できるだけ操作を簡単にするためにVBAで記述しておき、ボタン一つで更新できると間違いを減らす事ができます。

フォームを用意する

フォームにボタンを配置してデータベースのパス名を設定して、テーブルリンクボタンをクリックすると操作が簡単です。

DBPathテキストボックス： txtDBPath

参照ボタン： btnFileDialog

テーブルリンクボタン： btnTblLink

戻るボタン：終了

テーブルリンクボタンのイベントプロシージャ

テーブルリンクボタンがクリックされたときのイベントを記述します。

Private Sub btnTblLink_Click()
On Error GoTo Err_Handler
    
    Dim AdoCat As New ADOX.Catalog
    Dim AdoTbl As New ADOX.Table
    Dim fPath As String

    fPath = Me.txtDBPath.Value '変更するmdbパス
    AdoCat.ActiveConnection = CurrentProject.Connection
    
    ' リンクの更新
    For Each AdoTbl In AdoCat.Tables
        If (AdoTbl.Type = "LINK") Then 'リンクされたテーブルの場合
            AdoTbl.Properties("Jet OLEDB:Link Datasource") = fPath 'mdbパスを変更する
        End If
    Next
    Set AdoTbl = Nothing
    Set AdoCat = Nothing
    Exit Sub
    
Err_Handler:
    Set AdoTbl = Nothing
    Set AdoCat = Nothing
    
    MsgBox Err.Description
End Sub

以下の流れになります。

データベース部分のファイル名を fPathにセットする
コネクションをセットする
テーブルの一覧から１テーブルずつテーブルを取得して、テーブルのタイプがLINKの時にプロパティを更新する

参照ボタンのイベントプロシージャ

参照ボタンがクリックされたときのイベントを記述します。mdbとaccdbが表示されるように設定してあげます。

Private Sub btnFileDialog_Click()
On Error GoTo Err_Handler

    Dim dialogValue As Variant

    ' ファイルダイアログのカスタマイズと表示を行う。
    With Application.FileDialog(msoFileDialogFilePicker)

        ' 「ファイルの種類」プルダウンを初期化する。
        .Filters.Clear

        ' 「ファイルの種類」にExcelファイルとCSVファイルのみ表示されるように設定する。
        .Filters.Add "ACCESS ファイル", "*.mdb;*.accdb"

        ' 「ファイルの種類」に「Excel ファイル」をデフォルトで表示するように設定する。
        .FilterIndex = 1

        ' タイトルバーの表示文字列の設定
        .Title = "DBファイル選択"

        ' 初期選択フォルダの設定
        '.InitialFileName = ""

        ' 複数ファイル選択の設定（不可能に設定）
        .AllowMultiSelect = False

        ' Showメソッドを使い、ファイルダイアログを表示する。
        ' ファイルダイアログの[キャンセル]ボタンが押下されたら以降の処理はしない。
        ' ちなみに、キャンセル時にはShowメソッドは0を返す。
        If Not CBool(.Show) Then Exit Sub

        Me.txtDBPath.SetFocus
        Me.txtDBPath.Text = .SelectedItems(1)

    End With

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox Err.Description
    Resume Exit_Handler
End Sub

参照設定

VisualBasicエディタのツールメニューの参照設定を追加します。

Microsoft ADO Ext. 6.0 for DDL and Security
Microsoft Office 15.0 Object Library

上記２つをチェックしてあげれば今回のVBAは動作すると思います。