VBAでリンクテーブルを作成・更新[by ADOx]

★やりたい事
　Accessで、他のDBを参照してリンクテーブルを作成する。

★環境
　・WindowsXP SP3
　・Access2003

★リンクテーブルを作成するための関数
　※以下のオレンジの太文字を環境に応じて変更して下さい。
　◆備考
　　・リンクテーブルが存在しない場合はリンクテーブルを作成
　　・同名のリンクテーブルが存在する場合は上書き(処理は削除して新規作成)

━━━━━━━━━━━━━━━━━━━━━━━━━
Public Function mk_tbl_link()

  '★参照ライブラリ ･･･ 以下を参照しないと動作しません。
    '・Microsoft ADO Ext 2.8 DLL And Security

  '---------------------------------------------
  '★変数宣言
    Dim cat As New ADOX.Catalog
    Dim tbl() As New ADOX.Table
    Dim linkMDB As String
    Dim linkMDB_path As String
    Dim linkMDB_file As String
    Dim linkTblNames() As String
    Dim i As Integer
    Dim tblNames As Variant

    Dim itemNum As Integer
    'リンクするテーブル数を入力。ただし、配列だから0からスタートに注意！
    itemNum = 6

    ReDim tbl(itemNum) As New ADOX.Table
    ReDim linkTblNames(itemNum) As String

  '---------------------------------------------
  '★値のセット
    linkMDB_path = "D:リンク先のパス"
    linkMDB_file = "リンク先のMDB.mdb"
    linkMDB = linkMDB_path & linkMDB_file
    i = 0
    cat.ActiveConnection = CurrentProject.Connection

    'リンクするテーブル名をセット
    linkTblNames(0) = "リンクするテーブル名1"
    linkTblNames(1) = "リンクするテーブル名2"
    linkTblNames(2) = "リンクするテーブル名3"
    linkTblNames(3) = "リンクするテーブル名4"
    linkTblNames(4) = "リンクするテーブル名5"
    linkTblNames(5) = "リンクするテーブル名6"
    linkTblNames(6) = "リンクするテーブル名7"

  '---------------------------------------------
  '★メイン処理
    For Each tblNames In linkTblNames
    '■各種設定
      Set tbl(i).ParentCatalog = cat
      tbl(i).Properties("Jet OLEDB:Create Link") = True
      tbl(i).Properties("Jet OLEDB:Link Datasource") = linkMDB

      'パスワード ･･･ 参照先DBにパスワードがある場合はここを記入
      'tbl(i).Properties("Jet OLEDB:Link Provider String") = ";pwd=リンク先のMDBのパスワード"

      'リンクしたテーブル名
      tbl(i).Name = tblNames

      'ソーステーブル名
      tbl(i).Properties("Jet OLEDB:Remote Table Name") = tblNames

    '■リンクテーブル処理
      For Each TB In cat.Tables
        If TB.Name = tblNames Then
          'テーブル削除
          cat.Tables.Delete tbl(i).Name
          Exit For
        Else
          '
        End If
      Next TB

      'リンクテーブル作成
      cat.Tables.Append tbl(i)

      'インクリメント
      i = i + 1
    Next tblNames

  'オブジェクトの破棄
  Set cat = Nothing
  Set tbl(itemNum) = Nothing

  '終了メッセージ
  MsgBox ("リンクテーブルの作成/更新が完了しました")

End Function
━━━━━━━━━━━━━━━━━━━━━━━━━