リンクテーブルの自動更新

MS-Access で、リンクテーブルでデータテーブルを別ファイル等に設定していた場合、端末や場所を移動した場合に、リンクテーブルでデータテーブルを指定し直す必要があります。

これをサボろう。以下コード。

Private Sub LinkTableRenew()
    Dim strMsg as String
    strMsg = "リンクテーブルを自動更新しますか？" & vbcrlf & vbcrlf & _
      "ネットワーク先への接続試行がある場合、かなり時間がかかる場合があります。" & _
      "進捗状況は左下のステータスバー内メッセージで確認してください。"
    If MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbQuestion, "テーブル自動更新確認") = vbNo Then Exit Sub
   
   
    Dim objDB       As DAO.Database
    Dim objTB       As DAO.TableDef
    Dim aryTBpath   As Variant
    Dim strTBpath   As Variant
    Dim strCpath1   As String
    Dim strCpath2   As String
    Dim strCpath3   As String
   
    Set objDB = CurrentDb
   
    '-- カレントパスに置いた場合、こういった書き方も出来るっつー例
    strCpath1 = CurrentProject.Path & "hoge_db1.accdb"
    strCpath2 = CurrentProject.Path & "hoge_db2.accdb"
    strCpath3 = CurrentProject.Path & "hoge_dbRef.accdb"
   
    '-- 接続試行をファイル名も含めたフルパスで表記。先に書いたものからヒットした順にリンクを張る。
    aryTBpath = Array("C:\Documents and Settings\hoge\My Documents\access\hoge_be.accdb", _
                      "\\HogeServer\db\hoge_db.accdb", _
                      strCpath1, strCpath2, strCpath3)
   
    On Error Resume Next    'ネットワークエラーが出ても文句を言わない
    For Each objTB In objDB.TableDefs
        For Each strTBpath In aryTBpath
            If objTB.Connect <> "" Then          'リンクテーブルだけ処理
                objTB.Connect = ";DATABASE=" & CStr(strTBpath) & ";TABLE=" & objTB.Name
                objTB.RefreshLink
                strMsg = objTB.Name & "のリンク自動更新中です..."
                SysCmd acSysCmdSetStatus, strMsg
            End If
        Next
        strMsg = objTB.Name & "のリンク自動更新に成功！"
        SysCmd acSysCmdSetStatus, strMsg
    Next objTB
    objDB.Close: Set objDB = Nothing
    SysCmd acSysCmdClearStatus
   
    MsgBox "リンクテーブルの更新が終了しました。", vbOKOnly + vbInformation, "更新終了"
End Sub

 これで、ボタン一つで予め設定したデータベースにリンクを張り直せるはずです。設定するデータベースは、テーブルから読み直すように変更するなりご自由に。
……しかし、このブログ、内容が全然一貫してねぇ……