Attach DSNLessTable for SQL Server Native Client 10.0 (1 Viewer)

Function GetLinkedTablesForLocalTable() As Boolean
' Create a local table named SQL_Linked  ' A check in 3rd fild will delete Access linked and re-build SQL link
' 1st field text - "TableName", 2nd field yes/No "Linked" default =True, 3rd field yes/no "Relink" default=0
' Migrate All Access linked tables to SQL Server first. On mine a ODBC linkd shows dbo.TableName
' download and install SQL Server Native Client 10.0 on each client machine
          Dim dbs As DAO.Database
          Dim tdf As DAO.TableDef
          ' Loop through all tables in local DB
          GetLinkedTablesForLocalTable = False
10        Set dbs = CurrentDb
20        For Each tdf In dbs.TableDefs
30            If Len(tdf.Connect) > 0 Then  ' Table with connect string
40                If tdf.Connect <> ";DATABASE=" & MyDbName Then
50                    tdf.Connect = ";DATABASE=" & MyDbName
60                    Err = 0
70                    On Error Resume Next
80                    CurrentDb.Execute ("INSERT INTO SQL_Linked (TableName) VALUES ('" & tdf.Name & "' ) ;")
                      ' Table Named "SQL_Linked", field name "TableName" and value of tdf.name
                      ' Table SQL_Linked with a field named TableName must exist in local DB
90                    If Err <> 0 Then
100                       GetLinkedTablesForLocalTable = False
110                       Debug.Print "LOCAL " & tdf.Name ' these should not appear - reference only
120                       Exit Function
130                   End If
140               End If
150           End If
160       Next tdf
170       GetLinkedTablesForLocalTable = True        ' Refresh the table SQL_Linked and view all the linked table names
 
End Function
 
' Use this for the stConnect shown above
Function ModifiedRefreshDNSLess2(TableName As String) As String ' temp test database
      Dim ConnectString As String
      Dim strConnectionString As String
      Dim scn As String
      Dim sLocalName As String
      Dim UID As String
      Dim PWD As String
10    UID = "datamig"     ' temp SQL name change later
20    PWD = "datamig"
30    sLocalName = TableName  ' "Const_Seed" ' <<<---manually add a table name
      Dim DataBaseName As String
40    DataBaseName = "RegulatoryDB"
50    strConnectionString = "ODBC;DRIVER=SQL Server Native Client 10.0;" & _
          "SERVER=DenReg-Test;DATABASE=" & DataBaseName & ";" & _
          "UID=" & UID & ";" & _
          "PWD=" & PWD & ";" & _
          "Table=DBO." & sLocalName & ";Option=3;"
60        ModifiedRefreshDNSLess2 = strConnectionString
          'Debug.Print strConnectionString
End Function
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 datamig was created with sqlserver security
      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)
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 of the local table \\\\\
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
120                                     CurrentDb.TableDefs.Delete 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
      ' ////////////// create and  Relink to SQL Server if check is in Relink column  ///////////
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)
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
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
Sub RerefreshLinkedTables() ' refreshes Linked tables doesn't refresh icon
          Dim dbs As DAO.Database
          Dim tdf As TableDef
10        Set dbs = CurrentDb
20        For Each tdf In dbs.TableDefs
30            If Len(tdf.Connect) > 0 Then
40                    tdf.RefreshLink
                      'Debug.Print tdf.Name
50            End If
60        Next tdf
70        Set dbs = Nothing
End Sub
Public Function DropAllLinkedTables()
10        For Each tdf In CurrentDb.TableDefs    ' If the table has a connect string, it's a linked table.
              ' Drop all tables and rebuild again from local table SQL_Linked where names are stored
20            If Len(tdf.Connect) > 0 Then
30                DoCmd.DeleteObject acTable, tdf.Name
40            End If
50        Next tdf
End Function