リンクテーブル更新

Function append_LinkTables()

'Accessリンクテーブルを設定します
'2009-03-31 Kotaka


Dim strPath As String

'カレントパス
'strDbPath = Application.CurrentProject.Path
'strDbPath = "X:\"
strDbPath = "C:\work\access\New登録スタッフデータ\"

'DB名取得
strDBName = "New登録スタッフデータ.mdb"


'フルパス作成
strDBObjectFull = strDbPath & "\" & strDBName

MsgBox "リンクします" & strDbPath & strDBName, vbNormal, "リンクテーブル更新"


Dim テーブル一覧(0 To 13)  As String
テーブル一覧(0) = "Table応対記録M"
テーブル一覧(1) = "Tableスタッフ名簿M"
テーブル一覧(2) = "Tableソフト名M"
テーブル一覧(3) = "Table営業担当者M"

Dim i As Integer
Dim TableName As String

For i = 0 To UBound(テーブル一覧)

    TableName = テーブル一覧(i)
    'MsgBox "リンクします: " & テーブル一覧(i), vbInfoText
    
    Set objTBLDef = CurrentDb.CreateTableDef(TableName)
    objTBLDef.Connect = ";DATABASE=" & strDBObjectFull
    objTBLDef.SourceTableName = TableName
    
    On Error Resume Next
    
    CurrentDb.TableDefs.Delete (TableName)
    CurrentDb.TableDefs.Append objTBLDef
    'CurrentDb.TableDefs.Refresh

Next i

MsgBox "リンク更新 完了"

Exit Function

End Function