Option Compare Database
Option Explicit
' ///////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SQL_Linked_Table_Backup() ' Access 2010 SQL 2008 R2 - linked tables backed up to Access
' 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 column will copy data to create a local table in Access
Dim TableNameToCopy As String
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
90 Debug.Print Counter & "/" & RecordsCount & " Field value " & rsSQLLinked.Fields(0).Value & " " & rsSQLLinked.Fields(2).Value
100 If rsSQLLinked.Fields(2).Value Then ' if Relink checkbox is true then
110 TableNameToCopy = rsSQLLinked.Fields(0).Value
120 MakeTableInDB (TableNameToCopy) ' call subroutine below
130 Err.Clear
140 End If
150 rsSQLLinked.MoveNext
160 Next Counter
170 CurrentDb.TableDefs.Refresh ' this doesn't work on my desktop - must manually refresh the table container
180 Else
190 MsgBox "There are no records in the table", vbOKOnly, "SQL_Linked_Table_Backup"
200 Exit Sub
210 End If
' ////////////// Relink to SQL Server ///////////
220 CurrentDb.TableDefs.Refresh
' ////////////////
230 Set rsSQLLinked = Nothing
240 Set tdLinked = Nothing
250 Set td = Nothing
260 Exit Sub
End Sub
' /////////////////////////////////////////
Public Sub MakeTableInDB(TableName As String)
Dim mysql As String
Dim DBPath As String
Dim Result
Dim TblName As String
Dim TblNameDestination As String
Dim RecordCount As Long
Dim RecordCountMessage
10 On Error GoTo PROC_EXIT
20 DoCmd.Hourglass True
' this program links to this database - and copies linked tables to local tables if the table SQL_Linked has a checkbox checked
' It could be easily modified to add a different path
30 DBPath = "C:08CustomImport.accdb" ' <<<<----------- Hard coded DB here -
40 TblName = TableName ' Read from linked table - passed in as parameter
50 TblNameDestination = TblName & "_Backup" ' Table name + _Backup
' Only change path here <<<<<<<<<<<<<<<<<<< Database path and Table Name >>>>>>>>>>>>>>>>>>>>>>>>>
60 mysql = "SELECT " & TblName & ".* "
70 mysql = mysql & " INTO " & TblNameDestination & " IN '" & DBPath & "'"
80 mysql = mysql & " From " & TblName
'Debug.Print mysql
90 CurrentDb.Execute mysql
100 Debug.Print " Err.description " & Err.Description & " Err.number is: " & Err.Number ' no errors - but "You do not have exclusive access to the database at this time" if switch to design mode.
110 DoCmd.Hourglass False
PROC_EXIT:
120 On Error Resume Next
130 DoCmd.Hourglass False
140 Exit Sub
PROC_ERROR:
150 Select Case Err.Number ' not used here, but useful to know
Case 3010
160 MsgBox "Error 3010", vbOKOnly, "Update Remote DB"
170 Case Else
180 MsgBox " please make a note of this unknown error: " & Err.Description, "Unknown Error"
190 Resume PROC_EXIT
200 End Select
End Sub
