Can you please try this updated code, please note the comments I added (please post VBA code using the code tags - #-, makes it easier to follow and avoids the extra spaces inserted by the forum software):
Code:
Public Sub cmdConnect_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rst As DAO.Recordset
Dim strServer As String
Dim strDB As String
Dim strTable As String
Dim strConnect As String
Dim strMsg As String
On Error GoTo HandleErr
strConnect = "ODBC;Driver={SQL Server};SERVER=server;DATABASE=database;UID=userdetails;PWD=*********;Trusted_Connection=No;APP=Microsoft Office;"'Vlad: I assume you have the actual UID and PWD populated in this string as they don't seem to come from the tblSQLTables. I would also recommend using a newer SQL server driver - https://docs.microsoft.com/en-us/sql/connect/odbc/download-odbc-driver-for-sql-server?view=sql-server-ver15
' Get rid of any old links.
Call DeleteLinks 'Vlad - this was commented out so the add new was failing because you already had the table(s)
' Create a recordset to obtain server object names.
Set db = CurrentDb
Set rst = db.OpenRecordset("tblSQLTables", dbOpenSnapshot)
If rst.EOF Then
strMsg = "There are no tables listed in tblSQLTables."
GoTo ExitHere
End If
' Walk through the recordset and create the links.
Do Until rst.EOF
strServer = rst!SQLServer
strDB = rst!SQLDatabase
strTable = rst!SQLTable
' Create a new TableDef object.
Set tdf = db.CreateTableDef(strTable)
' Set the Connect property to establish the link.
'tdf.Connect = strConnect & "Server=" & strServer & ";Database=" & strDB & ";"
tdf.Connect=Replace(Replace(StrConnect,"=server",strServer),"=database",strDB)
tdf.SourceTableName = strTable
' Append to the database's TableDefs collection.
db.TableDefs.Append tdf
rst.MoveNext
Loop
db.TableDefs.Refresh
Application.RefreshDatabaseWindow
strMsg = "Connected to server successfully"
rst.Close
Set rst = Nothing
Set tdf = Nothing
Set db = Nothing
ExitHere:
'MsgBox strMsg, , "Link SQL Tables"
Exit Sub
HandleErr:
Select Case Err
Case Else
strMsg = Err & ": " & Err.Description
Resume ExitHere
End Select
End Sub
Public Sub DeleteLinks()
' Delete any leftover linked tables from a previous session.
Dim tdf As DAO.TableDef
On Error GoTo HandleErr
For Each tdf In CurrentDb.TableDefs
With tdf
' Delete only SQL Server tables.
'If (.Attributes And dbAttachedODBC) = dbAttachedODBC Then
if Instr(tdf.Name,"SQL Server")>0 Then 'Vlad: I use InStr to check if the connect string contains the words "SQL server", the previous line might work as well, but I never used it
CurrentDb.Execute "DROP TABLE [" & tdf.Name & "]"
End If
End With
Next tdf
ExitHere:
Set tdf = Nothing
Exit Sub
HandleErr:
MsgBox Err & ": " & Err.Description, , "Error in DeleteLinks( )"
Resume ExitHere
Resume
End Sub
Cheers,