Public Function SetLinkedTables()
Dim db As Database
Dim Cnct As String
Dim tdf As TableDef
Dim sCon As Variant
Dim a As Integer
Dim sVar As Variant
Dim sName As String
Dim sServer As String
Dim sPWord As String
Dim sUser As String
On Error GoTo SLT_Err
Set db = CurrentDb
db.TableDefs.Refresh
' Loop Table Defs
For Each tdf In db.TableDefs
With tdf
'MsgBox "connect : " & .Connect
'split current string to find db data
sCon = Split(.Connect, ";")
For a = 0 To UBound(sCon)
If sCon(a) <> "" Then
sVar = Split(sCon(a), "=")
If sVar(0) = "DATABASE" Then
Cnct = sVar(1)
If left(.Name, 4) = "dbo_" Then
sName = Right(.Name, Len(.Name) - 4)
sServer = "127.0.0.1, 1433"
sPWord = "MyPWD"
sUser = "MyUID"
ElseIf left(.Name, 4) = "rem_" Then
sName = Right(.Name, Len(.Name) - 4)
sServer = "127.0.0.1, 1433"
sPWord = "MyPWD"
sUser = "MyUID"
ElseIf left(.Name, 4) = "cld_" Then
sServer = "127.0.0.2, 1433"
sPWord = "MyPWD"
sName = Right(.Name, Len(.Name) - 3)
sUser = "MyUID"
Else
sName = .Name
sServer = "127.0.0.3, 1433"
sPWord = "MyPWD"
sUser = "MyUID"
End If
' create connection to table
Call AttachDSNLessTable(.Name, sName, sServer, Cnct, sUser, sPWord)
End If
End If
Next
End With
Next
db.TableDefs.Refresh
Set tdf = Nothing
Set db = Nothing
MsgBox "Tables Re-Linked."
SLT_Exit:
Exit Function
SLT_Err:
MsgBox "Error in SetLinkedTables : " & Err.Description
Resume SLT_Exit
End Function
Public Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
On Error GoTo AttachDSNLessTable_Err
Dim td As TableDef
Dim stConnect As String
For Each td In CurrentDb.TableDefs
If td.Name = stLocalTableName Then
CurrentDb.TableDefs.Delete stLocalTableName
End If
Next
If Len(stUsername) = 0 Then
'//Use trusted authentication if stUsername is not supplied.
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
Else
'//WARNING: This will save the username and the password with the linked table information.
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
End If
Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
CurrentDb.TableDefs.Append td
AttachDSNLessTable = True
Exit Function
AttachDSNLessTable_Err:
AttachDSNLessTable = False
MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Description
End Function