MS-Accessでリンクテーブルを張替え(VBA)

pythonで書きたくても、VBAなんかを書かなくちゃいけないときもある。一応成果メモ。

MS-Accessで、データ自体はどこかの共有フォルダ内のmdbファイルに置いておいて、それを各クライアントがリンクテーブルとして使う、という運用はよくあるパターン。

で、クライアントを新しく配置するごとに、リンクテーブルをちまちま張りなおすのは面倒だなあ、ということで、モジュール化した。refresh_link_tables というサブルーチンを呼ぶと、ネットワークフォルダにドライブ名を振って、リンクテーブルの定義を消して、あたらしくリンクを作り直している。

Function exists_table(ByVal name As String)
    On Error Resume Next
    exists_table = CurrentDb.TableDefs(name).name = name
End Function

Sub connect_net_drive()
    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")
    '環境にあわせて適宜変える。最後のTrueは同期実行のしるし
    oShell.Run "NET USE Q: \\some_server\shared_folder passwd1 /USER:user1", , True
    Set oShell = Nothing
End Sub

Public Sub refresh_link_tables()
    Call connect_net_drive
    tt = Array("master", "master2", "journal1", ...... )  'リンクするテーブルをいくつでも
    For Each table_name In tt
        If exists_table(table_name) Then
            CurrentDb.TableDefs.Delete (table_name)
        End If
        Set tdef = CurrentDb.CreateTableDef(table_name)
        tdef.Connect = ";database=Q:\sample\shared_db.mdb"  '環境にあわせて書き換え
        tdef.SourceTableName = table_name
        CurrentDb.TableDefs.Append (tdef)
    Next
End Sub

補足：WScript.Shell オブジェクトを作ってNTコマンドを外部で実行するというのがなんだか格好悪いと思うなら、WScript.Network オブジェクトの MapNetworkDrive メソッドを使っても似たことができる。まあ、やりたいことが実現するのならなんでもいいや。