Copy a ODBC-linked SQL-Table to an Access table with VBA - sql-server

Question

I have some ODBC-linked SQL-Server tables in my Access DB, which are the production environment. For testing I want to copy all the data from the SQL-Server into structure-identical Access tables so that I have an identical set of tables in a dev or test-environment. To make it difficult: All of these tables have autoincrement IDs and I want the copies to have the same values and of course the copied ID field also as autoincrement long.
So, a set of these tables:
- dbo_tbl_Abcd
- dbo_tbl_Efgh etc.
should be copied to:
- Dev_Abcd
- Dev_Efgh etc.
or to:
- Test_Abcd
- Test_Efgh etc.
When I do a manual copy and paste for each single table this will work without problems. A dialog "Paste Table As" appears where you have the options:
Linked Table
Structure Only
Structure and Data
Append Data to Existing Table
When you set the name correctly and choose Structure and Data, you will have a proper copy as Access table with the same values in the Auto-ID field. I just want to do this by code and for all ODBC-Tables at once (in a loop). When Access provides this manual copying, there must be a way to do this by code.
I have already tried this:
DoCmd.CopyObject , "Dev_Abcd", acTable, "dbo_tbl_Abcd"
but this only will create more ODBC-links to the same SQL-Server tables.
I also tried this:
DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentDb.Name, acTable, "dbo_tbl_Abcd", "Dev_Abcd"
This led to the following error:
The Microsoft Access database engine could not find the object . Make sure the object exists and that you spell its name and the path name correctly. (Error 3011)
I experimented a lot with DoCmd.TransferDatabase, but cound't find a working setting.
I did not test any "SELECT INTO"-Statements because of the autoincrement field.

Answer 1

What you are asking can be done like
CurrentDb.Execute "select * into localTable from dbo_serverTable" , dbFailOnError
And to do this to all the tables use this sub
Sub importSrverTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
If Left(LCase(tdf.Name), 4) = "dbo_" Then
'CurrentDb.Execute "select * into localTable from dbo_serverTable", dbFailOnError
db.Execute "select * into " & Mid(tdf.Name, 5) & " from " & tdf.Name, dbFailOnError
' the next if is to make the loop wait until the transfer finish.
If db.RecordsAffected > 0 Then
' do nothing
End If
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub

Answer 2

I've done something similiar. Change the ConnectionString to your environment. Maybe you have to extend the TranslateDatatype function.
Function TranslateDatatype(value As Long) As String
Select Case value
Case 2: TranslateDatatype = "INT" ' adSmallInt
Case 3: TranslateDatatype = "LONG" ' adInteger
Case 200: TranslateDatatype = "STRING" ' adVarChar
Case 202: TranslateDatatype = "STRING" ' adVarWChar
Case 17: TranslateDatatype = "BYTE" ' adUnsignedTinyInt
Case 11: TranslateDatatype = "BIT" ' adBoolean
Case 129: TranslateDatatype = "STRING" ' adChar
Case 135: TranslateDatatype = "DATE" ' adDBTimeStamp
Case Else: Err.Raise "You have to extend TranslateDatatype with value " & value
End Select
End Function
Sub CopyFromSQLServer()
Dim SQLDB As Object, rs As Object, sql As String, i As Integer, tdf As TableDef
Dim ConnectionString As String
Set SQLDB = CreateObject("ADODB.Connection")
ConnectionString = "Driver={SQL Server Native Client 11.0};Server=YourSQLServer;Database=YourDatabase;trustedConnection=yes"
SQLDB.Open ConnectionString
Set rs = CreateObject("ADODB.Recordset")
Set rs.ActiveConnection = SQLDB
For Each tdf In CurrentDb.TableDefs
rs.Source = "[" & tdf.Name & "]"
rs.Open
sql = "("
i = 0
Do
sql = sql & "[" & rs(i).Name & "] " & TranslateDatatype(rs(i).Type) & ", "
i = i + 1
Loop Until i = rs.Fields.Count
rs.Close
sql = "CREATE TABLE [Dev_" & tdf.Name & "] " & Left(sql, Len(sql) - 2) & ")"
CurrentDb.Execute sql, dbFailOnError
sql = "INSERT INTO [Dev_" & tdf.Name & "] SELECT * FROM [" & tdf.Name & "]"
CurrentDb.Execute sql, dbFailOnError
Next
End Sub