Option Explicit
Private Sub 実行1_Click()
Dim DBPath As String
Dim TargetTableName As String
Dim LinkTableName As String
DBPath = "C:\Users\元DB.accdb"
'リンク元となるDBのテーブル名'
TargetTableName = "T_test1"
'リンクテーブルのテーブル名'
LinkTableName = "リンクテーブル_test1"
Call リンクテーブル作成(DBPath, TargetTableName, LinkTableName)
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Private Sub リンクテーブル作成(DBPath As String, TargetTableName As String, LinkTableName As String)
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
cat.ActiveConnection = CurrentProject.Connection
Set tbl.ParentCatalog = cat
tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Link Datasource") = DBPath
tbl.Properties("Jet OLEDB:Remote Table Name") = TargetTableName
tbl.Name = LinkTableName
cat.Tables.Append tbl
Set cat = Nothing
Set tbl = Nothing
End Sub
