'===================================================================================================

'##### подключение таблицы

'DoCmd.TransferDatabase acLink, "Microsoft Access", strBase, acTable, TName, NewTName, False, False

'Set connDB = CreateObject("ADODB.Connection")

'ConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _

"Dbq=D:\Public\Documents\Temp\data_ref_User.accdb;Uid=Admin;Pwd=;"

Sub test_FnLinkTable()

Dim strAppVersion As String

strDataLinkName = "D:\Public\Documents\Temp\data_ref_User.accdb"

strDataName = "D:\Public\Documents\Temp\data_ref.accdb"

Set oDb = FnCreateDataBaseDAO(strDataName)

'On Error Resume Next

strAppVersion = Application.Version

Select Case strAppVersion

Case "12.0"

strConnect = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source" & _

strDataLinkName & _

"; Jet OLEDB:Database;"

Case "15.0"

strConnect = "Provider=Microsoft.ACE.OLEDB.15.0;Data Source=" & _

strDataLinkName & _

";Persist Security Info=False;Password="""";User ID=Admin"

Case "16.0"

strConnect = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & _

strDataLinkName & _

";Persist Security Info=False;Password="""";User ID=Admin"

Case Else

End Select

Подключение_таблицы = Fn_LinkTable(oDb, "TblLinck", "ListRefBlock", strConnect)

End Sub

'--------------------------------------------------------------------------------------------------

Private Function Fn_LinkTable(ByVal oDb As dao.Database, _

ByVal LinkedTableName As String, _

ByVal TableToLink As String, _

ByVal connectString As String) As Boolean

Dim tdf As New dao.TableDef

On Error GoTo Error_Fn_LinkTable

With oDb 'CurrentDb

Set tdf = .CreateTableDef("TblLinck")

tdf.Connect = ";DATABASE=D:\Public\Documents\Temp\data_ref_User.accdb" & _

IIf(Len(PWDvalue & "") = 0, "", ";PWD=" & PWDvalue) 'Вне зависимости от наличия пароля, но если пароль установлен, то будет использован пароль, сохранённый в переменной PWDvalue

tdf.SourceTableName = "ListRefBlock"

.TableDefs.Append tdf

'----------------------------------------

'с такой строкой подключения не пашет

'.TableDefs.Refresh

'Set tdf = .CreateTableDef(LinkedTableName)

'tdf.Connect = connectString

'tdf.SourceTableName = TableToLink

'.TableDefs.Append tdf

'.TableDefs.Refresh

'----------------------------------------

End With

Set tdf = Nothing

Exit_Fn_LinkTable:

Exit Function

Error_Fn_LinkTable:

MsgBox Err.Description

Resume Exit_Fn_LinkTable

End Function

'==================================================================================================

Явно:

Код:

Dim db As Database

Dim tdf As TableDef

Set db = CurrentDb

Set tdf = db.CreateTableDef("Фирмы")

tdf.Connect = ";DATABASE=C:\Documents and Settings\Андрэич\Рабочий стол\Companies.accdb;PWD=12345"

tdf.SourceTableName = "Фирмы"

db.TableDefs.Append tdf

Через переменные:

Код:

Dim db As Database

Dim tdf As TableDef

Set db = CurrentDb

Set tdf = db.CreateTableDef("Фирмы")

tdf.Connect = ";DATABASE=" & Pname & ";PWD=" & PWDvalue

tdf.SourceTableName = "Фирмы"

db.TableDefs.Append tdf