Issue linking tables from external database protected with password (1 Viewer)

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
Good day!
I have a back-end database which is protected with password.
the following code imports one table only, I need a code to: 1) Link all tables in the back-end database; 2) Link particular tables.
Code:

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strConnect As String
Dim strDbFile As String
Dim strLinkName As String
Dim strPassword As String
Dim strSourceTableName As String
Dim tdfBE As DAO.TableDef
Dim tdfFE As DAO.TableDef

strDbFile = "D:\myfile.accdb"
strPassword = "abc"

strSourceTableName = "client_master"
strLinkName = strSourceTableName

strConnect = "MS Access;PWD=" & strPassword & ";DATABASE=" & strDbFile
Debug.Print strConnect
Set db = CurrentDb
Set tdf = db.CreateTableDef
tdf.Connect = strConnect
tdf.SourceTableName = "xyz"
tdf.Name = strLinkName
db.TableDefs.Append tdf
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 19:22
Joined
Oct 29, 2018
Messages
19,154
Are you talking about creating new linked tables or relinking existing linked tables to a new BE location?
 

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
I'm talking about new linked tables. This code links only one table as prescribed in the (strSourceTableName = "client_master") line above.
I need to link all tables in the back end database with the same code Please!!!
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 19:22
Joined
Oct 29, 2018
Messages
19,154
I'm talking about new linked tables. This code links only one table as prescribed in the (strSourceTableName = "client_master") line above.
I need to link all tables in the back end database with the same code Please!!!
Okay, not in front of a computer now, but all you need to do is loop through the TableDefs collection of the BE file. Would you know how to do that?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:22
Joined
May 7, 2009
Messages
16,788
Code:
Public Function Relink(ByVal BE As String, db_pwd As String, ParamArray tblNames() As Variant)
'
'arnelgp
'
'Note:
'
'tblNames   put "*" to include all tables from BE
'           otherwise put the name of the table (separated by a comma (,))
'
'Example:
'
'Call Relink("d:\database\db_be.accdb", "my_password", "*")
'Call Relink("d:\database\db_be.accdb", "my_password", "table1")
'Call Relink("d:\database\db_be.accdb", "my_password", "table1", "table2")
'

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dict_BEtables As Object
    Dim dict_FEtables As Object
    Dim td As DAO.TableDef
    Dim i As Integer
    Set db = DBEngine.Workspaces(0).OpenDatabase(BE, False, False, "MS Access;PWD=" & db_pwd)
    Set rs = db.OpenRecordset( _
            "select [name] from mSysObjects where flags=0 and type=1;")
    With rs
        If Not (.BOF And .EOF) Then
            .MoveLast
            .MoveFirst
            Set dict_BEtables = CreateObject("scripting.dictionary")
        End If
        Do Until .EOF
            'Debug.Print !Name & ""
            If Not dict_BEtables.Exists(!Name & "") Then
                dict_BEtables.Add Key:=!Name & "", Item:=!Name & ""
            End If
            .MoveNext
        Loop
        .Close
    End With
    db.Close
    Set db = CurrentDb
    Set rs = db.OpenRecordset( _
            "select [name] from mSysObjects where type=6;")
    With rs
        If Not (.BOF And .EOF) Then
            .MoveFirst
            Set dict_FEtables = CreateObject("scripting.dictionary")
        End If
        Do Until .EOF
            dict_FEtables.Add Key:=!Name & "", Item:=!Name & ""
            .MoveNext
        Loop
        .Close
    End With
    'remove the local tables
    On Error Resume Next
    If tblNames(0) = "*" Then
        For i = 0 To dict_FEtables.Count - 1
            db.Execute "drop table [" & dict_FEtables.items()(i) & "];"
        Next
        On Error GoTo 0
        Application.RefreshDatabaseWindow
        For i = 0 To dict_BEtables.Count - 1
            Set td = db.CreateTableDef
            td.Name = dict_BEtables.items()(i)
            td.Connect = "MS Access;PWD=" & db_pwd & ";DATABASE=" & BE
            td.SourceTableName = dict_BEtables.items()(i)
            db.TableDefs.Append td
        Next
        Application.RefreshDatabaseWindow
    Else
        For i = 0 To UBound(tblNames)
            db.Execute "drop table [" & tblNames(i) & "];"
        Next
        On Error GoTo 0
        Application.RefreshDatabaseWindow
        For i = 0 To UBound(tblNames)
            If dict_BEtables.Exists(tblNames(i)) Then
                Set td = db.CreateTableDef
                td.Name = tblNames(i)
                td.Connect = "MS Access;PWD=" & db_pwd & ";DATABASE=" & BE
                td.SourceTableName = tblNames(i)
                db.TableDefs.Append td
            End If
        Next
        Application.RefreshDatabaseWindow
    End If
    Debug.Print "relinking done"
End Function
 
Last edited:

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
Thanks a lot. I'll try it and revert to you.
Thanks again
 

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
It works with "*" in tablenames but with selective tables it doesn't work neither it gives any error message.
I've also tried to refresh the database window manually, but still the same. !!!
I also noticed that when I use :
'Call Relink("d:\database\db_be.accdb", "my_password", "table1", "table2"
It deletes the "table1" and "table2" from database window, but doesn't relink them.
Many thanks
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:22
Joined
May 7, 2009
Messages
16,788
you missed the enclosing bracket )?
also i tried it many times, it deletes and re-create the linked table.
 

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
I revisited my code. the enclosing bracket ) is there.
I appreciate if you send me the sample on which you have tried.
Thanks a mile arnelgp
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:22
Joined
May 7, 2009
Messages
16,788
extract on same folder and run test_relink.accdb.
 

Attachments

  • test.zip
    477.7 KB · Views: 219

Capitala

Member
Local time
Today, 03:22
Joined
Oct 21, 2021
Messages
58
@arnelgp
It's working perfect. But my VBA can't access the tables.
I use the following code to deal with a table:
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb
Set rst = OpenForSeek("client_master")

rst.Index = "client_id"
rst.Seek "=", client_ID

And here's the OpenforSeek Function:

Set OpenForSeek = DBEngine.Workspaces(0).OpenDatabase _
(Mid(CurrentDb().TableDefs(TableName).Connect, _
11), False, False, "PWD="narsing").OpenRecordset(TableName, _
dbOpenTable)

I have a message (not a valid file name). if I disregard the OpenforSeek Function; I get a message: Operation is not supported for this type of object
SOS
 

Users who are viewing this thread

Top Bottom