ACCESSでプログラムを作成する際に、プログラム部分とデータベース部分に分ける事が良くあります。
分割することでプログラム修正後の入れ替え作業時にデータベースを誤って上書きしてしまう事を防止できます。
その際にプログラム部分のACCESS側でデータベースのリンクを行う必要がありますが、プログラムやデータベース部分の保存フォルダを変更したりすると、再度リンクし直さなければなりません。
全て自分で設定するときは手動でリンクし直せば良いのですが、利用者にやってもらう場合、たとえ簡単な手順であっても操作を間違ったりするものです。
できるだけ操作を簡単にするためにVBAで記述しておき、ボタン一つで更新できると間違いを減らす事ができます。
フォームを用意する
フォームにボタンを配置してデータベースのパス名を設定して、テーブルリンクボタンをクリックすると操作が簡単です。
DBPathテキストボックス: txtDBPath
参照ボタン: btnFileDialog
テーブルリンクボタン: btnTblLink
戻るボタン: 終了
テーブルリンクボタンのイベントプロシージャ
テーブルリンクボタンがクリックされたときのイベントを記述します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
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にセットする
- コネクションをセットする
- テーブルの一覧から1テーブルずつテーブルを取得して、テーブルのタイプがLINKの時にプロパティを更新する
参照ボタンのイベントプロシージャ
参照ボタンがクリックされたときのイベントを記述します。mdbとaccdbが表示されるように設定してあげます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
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
上記2つをチェックしてあげれば今回のVBAは動作すると思います。