Why does this vba table relink code result in error 3219? - sql-server

Question

I'm trying to relink tables in an MS Access database separate from the one the code below runs in; this way I can use the repairing db as "patch" of sorts...
I've modified the code I found here, so that it relinks the tables in a database opened by the "repairing / patch database"
Before I run the code I make sure both databases are open so that one can repair the other to make it easier to automate the application of the fix.
However when I run the code, when I get to the line reads tdfLinked.RefeshLink, which refreshes the linked table, I get an Runtime error '3219' Invalid Operation error.
Sub FixDB()
Call LinkTable("somelinkedTble", "SOMESERVER\NAMED_SQL_INST32", "Database1", "Some_Schema.somelinkedTble", True)
End Sub
Function LinkTable(LinkedTableAlias As String, Server As String, database As String, SourceTableName As String, OverwriteIfExists As Boolean)
'This method will also update the link if the underlying table definition has been modified.
'The overwrite parameter will cause it to re-map/refresh the link for LinktedTable Alias, but only if it was already a linked table.
' it will not overwrite an existing query or local table with the name specified in LinkedTableAlias.
' Begin: Bit that I modified to access the database that needs fixed.
Dim objAccess As Access.application
Dim loginInfo As New AuthInfoz
loginInfo.workgroup = "E:\Tickets\Fix\SEC\Secured.mdw"
loginInfo.username = "someuser"
loginInfo.password = "********"
loginInfo.dbs = "E:\Tickets\Fix\Report.mdb"
Set objAccess = GetObject(loginInfo.dbs).application
'Links to a SQL Server table without the need to set up a DSN in the ODBC Console.
Dim dbsCurrent As database
Dim tdfLinked As TableDef
' Open a database to which a linked table can be appended.
Set dbsCurrent = objAccess.CurrentDb
' END: Bit that I modified to access the external database.
'Check for and deal with the scenario ofthe table alias already existing
If TableNameInUse(LinkedTableAlias) Then
If (Not OverwriteIfExists) Then
Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
Exit Function
End If
'delete existing table, but only if it is a linked table
If IsLinkedTable(LinkedTableAlias) Then
dbsCurrent.TableDefs.Delete LinkedTableAlias
dbsCurrent.TableDefs.Refresh
Else
Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
Exit Function
End If
End If
'Create a linked table
Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
tdfLinked.SourceTableName = SourceTableName
tdfLinked.Connect = "ODBC;DRIVER={SQL Server};SERVER=" & Server & ";DATABASE=" & database & ";TRUSTED_CONNECTION=yes;"
On Error Resume Next
dbsCurrent.TableDefs.Append tdfLinked
If (Err.Number = 3626) Then 'too many indexes on source table for Access
Err.Clear
On Error GoTo 0
If LinkTable(LinkedTableAlias, Server, database, "vw" & SourceTableName, OverwriteIfExists) Then
Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
LinkTable = True
Else
Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
LinkTable = False
End If
Exit Function
End If
On Error GoTo 0
tdfLinked.RefreshLink
LinkTable = True
End Function
Function BuildSQLConnectionString(Server As String, DBName As String) As String
BuildSQLConnectionString = "Driver={SQL Server};Server=" & Server & ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function
Function TableNameInUse(TableName As String) As Boolean
'check for local tables, linked tables and queries (they all share the same namespace)
TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function
Function IsLinkedTable(TableName As String) As Boolean
IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function

Answer 1

Here's a proven example you should be able to adopt:
Public Function AttachSqlServer( _
ByVal Hostname As String, _
ByVal Database As String, _
ByVal Username As String, _
ByVal Password As String) _
As Boolean
' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.
Const cstrQuery1 As String = "_Template"
Const cstrQuery2 As String = "_TemplateRead"
Const cstrQuery3 As String = "VerifyConnection"
Const cstrDbType As String = "ODBC"
Const cstrAcPrefix As String = "dbo_"
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strConnect As String
Dim strName As String
On Error GoTo Err_AttachSqlServer
Set dbs = CurrentDb
strConnect = ConnectionString(Hostname, Database, Username, Password)
For Each tdf In dbs.TableDefs
strName = tdf.Name
If Asc(strName) <> Asc("~") Then
If InStr(tdf.Connect, cstrDbType) = 1 Then
If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
End If
tdf.Connect = strConnect
tdf.RefreshLink
Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
DoEvents
End If
End If
Next
dbs.QueryDefs(cstrQuery1).Connect = strConnect
dbs.QueryDefs(cstrQuery2).Connect = strConnect
dbs.QueryDefs(cstrQuery3).Connect = strConnect
Debug.Print "Done!"
AttachSqlServer = True
Exit_AttachSqlServer:
Set tdf = Nothing
Set dbs = Nothing
Exit Function
Err_AttachSqlServer:
Call ErrorMox
Resume Exit_AttachSqlServer
End Function