Public Sub SQL_Linked_Process() ' Access 2010 SQL 2008 R2
' A local Table SQL_Linked with fields TableName, linked, relink (the last two are yes/no check boxes)
' A procedure populates SQL_Linked with all the Access Linked table names.
' Placing a check (yes) in Relink will delete the Access Linked Table, and append a new Linked Table with DSNLess connection
' It is necessary to have migrated (updated) the Access DB to SQL - assume they have the same name.
' For data migration purpose and 1 level testing, a user <user name> was created with sqlserver security in this case.
'
' ----- Removed code - Code exist to link to Production or Test DB
' Test DB is just a SQL copy of production to conduct development
Dim rsSQLLinked As Recordset
Dim RecordsCount As Integer
Dim Counter As Integer
Dim td As TableDef ' for table SQL_Linked
Dim tdLinked As TableDef ' for new linked table
10 On Error Resume Next
20 Set rsSQLLinked = CurrentDb.OpenRecordset("SQL_Linked", dbOpenDynaset, dbSeeChanges)
30 rsSQLLinked.MoveLast
40 RecordsCount = rsSQLLinked.RecordCount
50 rsSQLLinked.MoveFirst
60 Debug.Print "Number of Linked Tables " & RecordsCount
' Delete the linked tables that have a check in the Relink Column
70 If RecordsCount <> 0 Then
80 For Counter = 1 To RecordsCount
'Debug.Print Counter & "/" & RecordsCount & " Field value " & rsSQLLinked.Fields(0).Value & " " & rsSQLLinked.Fields(2).Value
90 If rsSQLLinked.Fields(2).Value Then ' if Relink checkbox is true then
100 For Each td In CurrentDb.TableDefs
110 If td.Name = rsSQLLinked.Fields(0).Value Then
' insurance that existing linked tables are removed.
120 CurrentDb.TableDefs.Delete rsSQLLinked.Fields(0).Value
'Debug.Print "Error Deleting old links " & Err.Description & Err.Number & " " & rsSQLLinked.Fields(0).Value
130 Err.Clear
140 End If
150 Next
160 End If
170 rsSQLLinked.MoveNext
180 Next Counter
190 CurrentDb.TableDefs.Refresh
200 Else
210 MsgBox "There are no records in the table", vbOKOnly, "SQL_Linked_Process"
220 Exit Sub
230 End If
' ////////////// Relink to SQL Server ///////////
240 If RecordsCount <> 0 Then
250 rsSQLLinked.MoveFirst
260 For Counter = 1 To RecordsCount
'Debug.Print Counter & "/" & RecordsCount & " Field value " & rsSQLLinked.Fields(0).Value & " " & rsSQLLinked.Fields(2).Value
270 If rsSQLLinked.Fields(2).Value Then ' if Relink checkbox is true then
' Add new linked table here
'280 Set tdLinked = CurrentDb.CreateTableDef(rsSQLLinked.Fields(0).Value)
280 Set tdLinked = CurrentDb.CreateTableDef(rsSQLLinked.Fields(0).Value, dbAttachSavePWD) ' password persist now
290 tdLinked.Connect = ModifiedRefreshDNSLess2(rsSQLLinked.Fields(0).Value)
300 tdLinked.SourceTableName = "dbo." & rsSQLLinked.Fields(0).Value
310 CurrentDb.TableDefs.Append tdLinked
320 CurrentDb.TableDefs(rsSQLLinked.Fields(0).Value).RefreshLink
330 CurrentDb.Containers("Tables").Documents.Refresh ' doesn't refresh table icon
340 End If
350 rsSQLLinked.MoveNext
Debug.Print "Error " & Err.Description & Err.Number & " " & rsSQLLinked.Fields(0).Value
360 Err.Clear
370 Next Counter
380 CurrentDb.TableDefs.Refresh
390 RerefreshLinkedTables
400 Else
410 MsgBox "There are no records in the table", vbOKOnly, "SQL_Linked_Process"
420 Exit Sub
430 End If
' ////////////////
440 Set rsSQLLinked = Nothing
450 Set tdLinked = Nothing
460 Set td = Nothing
470 Exit Sub
End Sub