Changing linked table location programmatically - vba

I have an Access database with a linked table in a second database, located in the same directory as the first.
I would like to copy the whole directory to a new location (for testing) and have database one still link to the table in database two, but the linkage is still to the original directory, not the new location.
I'd like to do one of two things: either
Make the link to the table in database two in such a way that the folder path is relative - that the path to database two isn't hardcoded.
or
Have a routine in Form_Load (or an autoexec macro) that checks the application.path and programmatically adjusts the linkage accordingly.

Thanks,
I used it succesfull, however did not use it with the recordset.
Const LnkDataBase = "C:\NorthWind.mdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
dbs.TableDefs(strTable).RefreshLink
End If
End if
End If
Next tdf
End Sub

It can be useful to have a start-up form that allows you to browse for the back-end you want and a table of the tables that should be linked. You could iterate through the tables collection, but i think a list is slightly safer. After that, a little code is all that is needed, here is a snippet:
''Connection string with database password
strConnect = "MS Access;PWD=pw;DATABASE=" & Me.txtNewDataDirectory
Set rs = CurrentDb.OpenRecordset("Select TableName From LinkTables " _
& "WHERE TableType = 'LINK'")
Do While Not rs.EOF
''Check if the table is already linked, if it is, update the connection
''otherwise, link the table.
If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
Set tdf = db.CreateTableDef(rs!TableName, dbAttachSavePWD, _
rs!TableName, strConnect)
db.TableDefs.Append tdf
Else
db.TableDefs(rs!TableName).Connect = strConnect
End If
db.TableDefs(rs!TableName).RefreshLink
rs.MoveNext
Loop

I used usncahill's solution and modified it for my own needs. I do not have enough reputation to vote up their solution, so if you like my additional code, please vote us both up.
I wanted a quick way to switch between two back-end databases, one containing live data and the other containing test data. So I modified the previously mentioned code as follows:
Private Sub ReplaceLink(oldLink As String, newLink As String)
Dim tbl As TableDef, db As Database
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, oldLink) > 0 Then
tbl.Connect = Replace(tbl.Connect, oldLink, newLink)
tbl.RefreshLink
End If
Next
End Sub
Public Function ConnectTestDB()
ReplaceLink "Data.accdb", "Test.accdb"
End Function
Public Function ConnectLiveDB()
ReplaceLink "Test.accdb", "Data.accdb"
End Function
Public Function TestDBSwitch()
Dim tbl As TableDef, db As Database
Dim wasData As Boolean
Dim wasTest As Boolean
wasData = False
wasTest = False
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "JGFC Flooring Data") > 0 Then
wasData = True
ElseIf InStr(tbl.Connect, "JGFC Flooring Test") > 0 Then
wasTest = True
End If
Next
If wasData = True And wasTest = True Then
MsgBox "Data Mismatch. Both Test and Live Data are currently linked! Connecting all tables to Test database. To link to Live database, please run again.", , "Data Mismatch"
ConnectTestDB
ElseIf wasData = True Then
ConnectTestDB
MsgBox "You are now connected to the Test database.", , "Connection Changed"
ElseIf wasTest = True Then
ConnectLiveDB
MsgBox "You are now connected to the Live database.", , "Connection Changed"
End If
End Function
(The previous code assumes that both the Test and Live Data files are located in the same directory and the file name ends in Test and Data, but can be easily modified to other paths/filenames)
I call TestSwitchDB from a button in my front-end DB to quickly change between testing and production environments. My Access DB has user controls to switch between user environments, so when the admin user logs in to the front-end DB, I use the ConnectTestDB function directly to default the admin user to connect to the test DB. I likewise, use the ConnectLiveDB function when other users login to the front-end.
There is also a quick error detection in the TestSwitchDB function to tell me if there are a mix of connections to both environments prior to calling the switch function. If this error is recurrent, it could be a sign of other issues.

Our corporate IT changed the pathing our shared files from local to corporate, which necessitated redirecting all of our database tables. This would have a been pain, to delete and recreate all the links, especially with multiple different databases linked. I found this question but neither of the other answers worked well for me. The following is what I used. Note, this will take awhile with many tables as each update might take a few seconds.
Public Sub Fix_Table_Locations()
Dim tbl As TableDef, db As Database, strConnect As String
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "Portion of connect string to change") > 0 Then
tbl.Connect = Replace(tbl.Connect, "Portion of connect string to change", "New portion of connect string")
tbl.RefreshLink
End If
Next
End Sub

You may be able to use a relative path depending on where the files are located. The default location where Access looks is in Documents (C:\Users\UserName\Documents). So if you enter .. then it will take you one folder up from Documents, which is the user's folder. For example if your database file will always be stored at
C:\Users\UserName\Access App\Access Database
Then you can enter "..\Access App\Database" as the relevant file location. Otherwise you have to use VBA. In my case the file/file folders may not always be in the same location, some users may store the files on their Google drive, while others may use My Documents or the desktop. I was able to use a function similar to what usncahill posted:
Sub relinkBackendDB()
Dim sFilePath As String
Dim connectionString As String
Dim tbl As TableDef
Dim db As Database
sFilePath = (Application.CurrentProject.Path & "\system\Dojo Boss Database.accdb")
connectionString = ("MS Access;PWD=MyPassword;DATABASE=" & sFilePath)
Set db = CurrentDb
For Each tbl In db.TableDefs
If Len(tbl.Connect) > 0 Then
'MsgBox tbl.Connect 'If you're getting errors, uncomment this to see connection string syntax
tbl.Connect = connectionString
tbl.RefreshLink
End If
Next
End Sub
I call this function via the on_load event procedure when my "Home" form loads up, so it gets called whenever the app is first loaded/opened. This way it will always look in the relevant file folder, no matter what the user name is.

Related

Clear a linked table location, but keep the link

I have a database that works as a user interface to a few other databases. I link the secondary databases into the "front end" with linked tables.
So I have A.accdb, B.accdb, C.accdb, which all link into UI.accdb.
When I give this to people, some only get A, some only get B, some get A and C, and so on. The databases are expected to all be in the same folder. I am able to update the links by having a macro that relinks the UI back to each using the following (with some error handling).
Dim db As DAO.Database
Dim strConnect As String, dbName As String
Dim tdf As DAO.TableDef
Set db = CurrentDb
strConnect = ";DATABASE=" & CurrentProject.Path & "\"
For Each tdf In db.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = sMyConnectString & dbName
tdf.RefreshLink
End If
Next tdf
My problem is that if a user does not get B, for example, then their table links will not update location and the old file location is still saved in the link (but will not work since they don't have the file). I want to clean this up though.
Is there a way that in the error handling I can set tdf.connect to something that doesn't exist? I cannot set it to Null and I cannot seem to set it to some arbitrary string. Are there any other options to make the link not work, not show the previous location, but still exist? I want it to remain in case they get one of the other databases later.

Changing Linked Table Source Access 2016

I am trying to change the links in an Access 2016 database, but the method I've used in the past is not working as required.
I am using the
t.connect="new connection"
t.refreshlink
method, where t is a the table.
I have seen in the linked table manager that the tables are now grouped by a data source. I can create the new source and link it to the desired table, but I have many as migrating, so would like to do this in code.
I get no errors the current way, but immediately after the .refreshlink the table's .connect is still the same.
Is this still possible?
I currently populate a dictionary with the table name and it's existing connection, but only if non ODBC.
I am then looping through this dictionary, getting the table and changing its connection
CurrentDb.TableDefs(strTableName).Connect = strNewConnection
CurrentDb.TableDefs(strTableName).RefreshLink
Debug.Print CurrentDb.TableDefs(strTableName).Connect
Existing connection = ;DATABASE=\\app01\Access\CRM_Data.mdb
New connection =;DATABASE=C:\CRM_TEST\CRM_DATA_BE_2016.accdb
Many thanks
You should not use CurrentDb.TableDefs when changing tables, as that changes between calls and makes the reference to the tabledef where you change the connection string be a different one than the one where you refresh the link.
Dim d As DAO.Database
Set d = CurrentDb
d.TableDefs(strTableName).Connect = strNewConnection
d.TableDefs(strTableName).RefreshLink
AFAIK this behaviour is not version-dependent, so the code you provided should never have worked.
I am using this code in Access 2016 and it works just fine:
Public Function RelinkTables(environment As Integer)
On Error Resume Next
Dim tblDef As DAO.TableDef
For Each tblDef In CurrentDb.TableDefs
If tblDef.Connect <> "" Then
tblDef.Connect = GetConnectionString(environment)
tblDef.RefreshLink
End If
Next
End Function
Public Function GetConnectionString(environment As Integer) As String
Select Case environment
Case 1 ' connection to Test db
GetConnectionString = "your connection string to Test"
Case 2 ' connection to Prod db
GetConnectionString = "your connection string to Production"
End Select
End Function
If this would not work with your db than may be the path is wrong.

MS Access 2003 Refresh Linked ODBC Tables in VBA Causes Bloat

Using the following code, it is bloating the database size when refreshing the linked ODBC table connections. As such, the user will never be be able to finish the process completely without closing and re-opening the database for it to compact. The connections are linked from SQL and there are 13 linked tables in the database. The code resets the connection 4 times.
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim rs As DAO.Recordset
Dim strSite As String
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblSites")
'Run query against Default Site to create table
DoCmd.OpenQuery ("qryWarranty01") 'creates tblWarranty
'Loop through Site 2, Site 3 & Site 4 and append data to table
With rs
.MoveFirst
Do While .EOF = False
strSite = rs.Fields("Site")
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = "ODBC;DRIVER={SQL Server};SERVER=ServerName;DATABASE=" & strSite & ";UID=Username; PWD=Password;"
tdf.RefreshLink
End If
Next
DoCmd.OpenQuery "qryWarranty02" 'appends to tblWarranty
.MoveNext
Loop
End With
rs.Close
'Reset tables to be linked to Default Site
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = "ODBC;DRIVER={SQL Server};SERVER=ServerName;DATABASE=Site1;UID=Username; PWD=Password;"
tdf.RefreshLink
End If
Next
I've searched and searched for a resolution beyond Compacting and Repair. Can someone explain to me why the bloat is happening in this code and so fast? Is there another way to accomplish what I am needing to do?
I appreciate your help.
Thanks,
Cara
Here are some possibilities:
Ignore the bloat. Is it so extreme? What is so bad about Repair&Compact?
Only change .Connect and RefreshLink the tables that are used in qryWarranty02, not all 11 tables.
Create a SQL Server view from qryWarranty02, link that view. Now you only have to switch one TableDef.
Use a Pass-Through query instead of the linked view. I don't think changing the .Connect of a PT query causes the same bloat as for a table.
Have 4 Pass-Through queries with fixed connect strings for the 4 databases, and loop through them. No switching anymore (but redundancy in the queries).
That's normal and known (mis)behaviour.
You have no other options than either ignore the bloat (which you safely can do) or perform a compact afterwards.

Excel VBA Late Bind to Access and SQL Insert

I am having a frustrating issue with late binding to MS Access from Excel VBA to execute a DML statement like Insert or Update. All of the data I use in vba comes from user defined Classes. I can query just fine but writing to the DB gets different errors each time I try a different way to do the same thing. Below are some links to the same/similar issues, however each is slightly out of context and therefore I could not get passed my problem.
Microsoft.ACE.OLEDB.12.0 Current Recordset does not support updating error received when trying to update access
Operation must use an Updateable Query / SQL - VBA
Update an excel sheet using VBA/ADO
Operation must use an updatable query. (Error 3073) Microsoft Access
https://msdn.microsoft.com/en-us/library/bb220954%28v=office.12%29.aspx?f=255&MSPPError=-2147217396
http://www.access-programmers.co.uk/forums/showthread.php?t=225063
My end goal is to simply execute a DML string statement and it has to use late binding. Mainly I get the 3251 error saying my connection is 'Read Only' or a missing ISAM when I add ReadOnly=0 to the connection string. Fyi, getProjectFile just returns a path to a file starting from the parent folder of my project. I am pretty sure I can just use the connDB.Execute so I only need SQL Insert, I don't want to query first because the queries will get fat quick. I also think something might be wrong with the enum params because the ExecuteOptions want bitmasks instead of just a Long and I don't really know how to do that. From most of my research, I kept getting referred to the LockType and/or cursor not being right. For my environment; Windows 8.1 64bit, MS Office 2010 32bit(required). Does anyone see what is wrong here?
Sub ADO_Tester()
Dim strSQL, strFile, strConnection As String
Dim connDB As Object
'late bind to the ADODB library and get a connection object
Set connDB = CreateObject("ADODB.Connection")
'Connect to the DB
strFile = Application.ActiveWorkbook.Path & "\" & "PortfolioDB.accdb"
strConnection = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strFile & ";"
connDB.Open strConnection
'insert statement for a test record
strSQL = "INSERT INTO underlying_symbol (symbol) VALUES ('xyz')"
'execute the
connDB.Execute strSQL, , 2, 1 + 128
'clear the object
connDB.Close
Set connDB = Nothing
End Sub
Edit:
Early binding:
connDB.Execute strSQL, , adCmdText + adExecuteNoRecords
Late Binding: How to enter the value for adExecuteNoRecords? On msdn it is 0x80 and another post says &H0001,either way it gives a syntax error. It says enter a bitmask for this enum value.
connDB.Execute strSQL, , 1 + 0x80
Edit: Now the correct way -
adExecuteNoRecords (the ADO enum value) = 0x80 (a binary value) = 128 (a decimal value)
connDB.Execute strSQL, , 1 + 128
Edit: Now the issue gets even deeper. When I execute the code in a test spreadsheet into a test database, it works. When I copy and paste into the actual project spreadsheet and point to actual project db, I get the error: operation must use an updateable query . . . again. Same db name, same dml, same table name. The only difference is the actual DB is a product of a split to separate it from the forms and code in Access. Could this have changed some setting to make it read only?
Edit: It just gets deeper and deeper. The issue causing it not to work in the project db is because I have some Excel Tables querying the db. I made these through the Excel UI, Ribbon -> External Data -> Access -> etc. . . It has now become obvious these are causing me to be unable to insert DML because they are probably set to read only. How can I change the tables connections permissions? Is there another way I could be making these tables so that I can provide the connection? How to get Tables to be friendly with DML in VBA?
This worked for me:
Option Explicit
Private Const acCmdText As Integer = 1
Sub ADO_Tester()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim strFile As String
'Dim adoRecSet As Object
Dim connDB As Object
'late bind to the ADODB library and get a connection object
Set connDB = CreateObject("ADODB.Connection")
'Connect to the DB
strFile = getProjectFile("core", "PortfolioDB.accdb")
connDB.Open connectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strFile & ";"
'If State = 1, db connection is okay.
MsgBox "ADO Connection State is " & connDB.State & "."
'SQL to get the whole [underlying_symbol] table
'strSQL = "underlying_symbol" 'if options 2
'strSQL = "SELECT * FROM underlying_symbol" 'if options 1
strSQL = "INSERT INTO underlying_symbol (symbol) VALUES ('xyz')"
'late bind to adodb and get recordset object
'Set adoRecSet = CreateObject("ADODB.Recordset")
'&H0001 = bitmask for aCmdText
connDB.Execute strSQL, , acCmdText
'With adoRecSet
' .Open Source:=strSQL, _
' ActiveConnection:=connDB, _
' CursorType:=1, _
' LockType:=3, _
' Options:=&H1
'.AddNew
'.fields("symbol") = "XYZ"
'.Update
'End With
'------------------
'close the objects
'adoRecSet.Close
connDB.Close
'destroy the variables
'Set adoRecSet = Nothing
Set connDB = Nothing
ExitMe:
Exit Sub
ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
GoTo ExitMe
End Sub
Added some error handling, a constant that defines acCmdText (Why just not add a reference to ADO library? Up to you, though.), and a message box to check the connection state to the database, as I can't test your getProjectFile function. Late binding doesn't seem to be the issue here, I think the key line is:
connDB.Execute strSQL, , 2, &H1
Can really say what's going on here as I've never done it like this (code doesn't even compile), but changing it to
connDB.Execute strSQL, , acCmdText
worked for me.

Schema changes not updated in MS Access front end linked to the database

I created a new table in SQL server using SQL Server Management Studio but the MS Access front end linked to the database was not updated.
I tried reopening Access but still the new tables cannot be found. Yet when I check the SQL Server database they are there.
My tables in Access are linked to the database so I assumed any table or changes made in the SQL server database would be reflected in the Access front end. When I run a query in Access looking for the tables nothing is found. Another bit of information is when I right click and press view dependencies it says unable to view dependencies because
"unable to cast object of type 'System.DBNull' to type
'System.string'"
Something is maybe wrong with the way i save the query but I am not sure.
Your assumption:
I assumed any table or changes made in the SQL server database would
be reflected in the Access front end
...is not correct. Access does not automatically re-link when the SQL Server's schema changes, and it really can't. You're expecting Access assumes the data models between SQL Server and Access are the same. Even if your table and column names are exactly the same there are still differences to deal with since the data types have some differences. So, even in the best-case scenario Access does not have enough info to automatically re-link.
When you modify the SQL Server db you have to re-link from Access. Here's an article with some code that will allow you to do that quickly but note that you still have to launch it manually. And beware, as mentioned above, linking isn't that straightforward. If you use an automated method for linking the process will have to make some decisions, some of which make take you by surprise.
I have found the management of linked tables in access to be administratively tedious. In order to make my life simpler I have used the functions below that can be called to update the linked tables in access. This will take care of updating the structure of any changed table in SQL. Adding values to the SetTableNames function will bring in new tables
Private mstrTableNames(100) As String
Private const gcSQLDB as string = "MySQLServer"
Private const gcUserID as string = "SQLUserName"
Private const gcUserPassword as string = "SQLPassword"
Private const gcLiveDSN as string = "DSN"
Private const gcEmpty as string = ""
Public Function LinkLiveTables() As Boolean
Dim tdfLinked As TableDef
Dim strConnect As String
Dim intLoop As Integer
'Remove all non system tables from the application:
' !!!NB Add other exclusions so as to not delete tables that are not linked!!!
For Each tdfLinked In CurrentDb.TableDefs
If Left(tdfLinked.Name, 2) <> "MS" Then
If Left(tdfLinked.Name, 7) <> "tblTemp" Then
CurrentDb.TableDefs.Delete tdfLinked.Name
End If
End If
Next
'Create a linked table that points to SQL Server
strConnect = "ODBC;DATABASE=" & gcSQLDB & ";UID=" & gcUserID & _
";PWD=" & gcUserPassword & ";DSN=" & gcLiveDSN
SetTablesNames
For intLoop = 1 To 100
If mstrTableNames(intLoop) = gcEmpty Then GoTo ProcExit
Set tdfLinked = CurrentDb.CreateTableDef(mstrTableNames(intLoop))
With tdfLinked
.Connect = strConnect
.SourceTableName = "dbo." & mstrTableNames(intLoop)
End With
CurrentDb.TableDefs.Append tdfLinked
Next
ProcExit:
MsgBox "Connection to the LIVE tables was successful.", vbInformation
Exit Function
ProcError:
MsgBox "Link to LIVE tables Failed." & vbCrLf & vbCrLf & _
"Error Number : " & Err.number & vbCrLf & _
"Error Description : " & Err.Description, vbCritical
End Function
Private Sub SetTablesNames()
mstrTableNames(1) = "tblMoistureHist"
mstrTableNames(2) = "tblRawMaterials"
' ... add the additional table that you need as mstrTableNames(n) = "tablename"
End Sub