Log in

View Full Version : Create Table Link With VBA



afslaughter
05-11-2012, 03:56 PM
I want to link a table that has not been setup in the Linked Table Manager yet. This is probably real simple but I'm having a hard time figuring this out. I have looked at numerous examples from the forms and from Microsoft but it is over my head. I was hoping someone would be kind enough to explain this to a novice. This is what I have so far.

I have code to delete the table links that works fine:

DoCmd.DeleteObject acTable, "tblEquipment"
DoCmd.DeleteObject acTable, "tblUsers"
DoCmd.DeleteObject acTable, "tblShift"


And I have code to relink tables if they are already set up in the Linked Table Manager:

ReconnectMe:
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb()

MyPass = "Password"
MyPath = "C:\Some Folder\"

For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = ";PWD=" & MyPass & ";Database=" & MyPath & "MTO.accdb"
tdf.RefreshLink
End If
Next



This is as far as I got on what I'm looking for:

Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

MyPass = "Password"
MyPath = "C:\Some Folder\"

Set dbs = OpenDatabase(MyPath & "MTO.accdb", True, False, "MS Access;PWD=" & MyPass)

For Each tdf In dbs.TableDefs
Debug.Print " " & tdf.Name
If tdf.Connect <> "" Then
tdf.Connect = ";PWD=" & MyPass & ";Database=" & MyPath & "MTO.accdb"
tdf.RefreshLink
End If
Next



Doing a step by step of the code I see that all of the (tdf.Connect <>) don't meet the criteria to connect but I don't understand why.
Also if I manual force it to run the (tdf.Connect <>) line I get a run time error 3219 - Invalid Operation.

It would be really cool if some one can explain this to me. Thanks in advance.

HiTechCoach
05-16-2012, 07:31 AM
In your third code snippet you are opening an external database and checking to see if it is la link table. The will never be linked since it is the back end. Then your code is trying to link each table in the back end to itself. You need to create the linked table in the front end or CurrentDB().


I added comments to your code:


Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

MyPass = "Password"
MyPath = "C:\Some Folder\"


'** open back end database with password
Set dbs = OpenDatabase(MyPath & "MTO.accdb", True, False, "MS Access;PWD=" & MyPass)


'** loop through table in back end
For Each tdf In dbs.TableDefs
Debug.Print " " & tdf.Name

'** test back end table to see if it is linked
If tdf.Connect <> "" Then

'** if back end table is not linked, link it to itself in same database
tdf.Connect = ";PWD=" & MyPass & ";Database=" & MyPath & "MTO.accdb"
tdf.RefreshLink
End If
Next

afslaughter
05-17-2012, 05:35 AM
Thank you for the great explanation. I kept working with the examples and I was able to piece together something that works. It may not be the best solution but it is simple and I understand how it works.


Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

MyPass = "Password"
MyPath = "C:\Some Folder\"

' Delete links so there won't be any duplicates
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 15) <> "tblReportsState" And _
(tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
CurrentDb.TableDefs.Delete tdf.Name
End If
Next tdf
Set tdf = Nothing

' Setup Links
Set dbs = OpenDatabase(MyPath & "MTO.accdb", False, False, "MS Access;PWD=" & MyPass)

For Each tdf In dbs.TableDefs
If Left(tdf.Name, 4) <> "msys" Then
TableName = tdf.Name
Set tdf = CurrentDb.CreateTableDef(TableName)
tdf.Connect = ";PWD=" & MyPass & ";Database=" + MyPath + "MTO.accdb"
tdf.SourceTableName = TableName
CurrentDb.TableDefs.Append tdf
End If
Next


Also note I changed:

Set dbs = OpenDatabase(MyPath & "MTO.accdb", True, False, "MS Access;PWD=" & MyPass)

'to

Set dbs = OpenDatabase(MyPath & "MTO.accdb", False, False, "MS Access;PWD=" & MyPass)



This will allow you to open the tables and link up to them even if someone else has them open.

I want to thank you guys for helping out. Without the forums I would never be able to work through a project and try out new things.

HiTechCoach
05-17-2012, 04:58 PM
Great job figuring it out. :thumb

Thanks for sharing your solution so other may benefit. :bow: