使用 VBA 将 ODBC 链接的 SQL 表复制到 Access 表答案

【问题标题】：Copy a ODBC-linked SQL-Table to an Access table with VBA使用 VBA 将 ODBC 链接的 SQL 表复制到 Access 表
【发布时间】：2019-10-15 16:02:30
【问题描述】：

我的 Access DB 中有一些 ODBC 链接的 SQL-Server 表，它们是生产环境。为了进行测试，我想将 SQL-Server 中的所有数据复制到结构相同的 Access 表中，以便在开发或测试环境中拥有一组相同的表。让它变得困难：所有这些表都有自动增量 ID，我希望副本具有相同的值，当然复制的 ID 字段也具有自动增量长。

所以，一组这些表：
- dbo_tbl_Abcd
- dbo_tbl_Efgh 等。

应复制到：
- Dev_Abcd
- Dev_Efgh 等。

或到：
- Test_Abcd
- Test_Efgh 等。

当我为每个表进行手动复制和粘贴时，这将毫无问题。将出现一个对话框“将表格粘贴为”，您可以在其中选择：

链接表
仅结构
结构和数据
将数据追加到现有表

当您正确设置名称并选择结构和数据时，您将获得一个正确的副本作为 Access 表，在 Auto-ID 字段中具有相同的值。我只想通过代码一次性完成所有 ODBC 表（循环）。当 Access 提供这种手动复制时，必须有一种方法可以通过代码来完成。

我已经试过了：

DoCmd.CopyObject , "Dev_Abcd", acTable, "dbo_tbl_Abcd"

但这只会创建更多指向相同 SQL-Server 表的 ODBC 链接。我也试过这个：

DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentDb.Name, acTable, "dbo_tbl_Abcd", "Dev_Abcd"

这导致了以下错误：
Microsoft Access 数据库引擎找不到对象。确保对象存在并且正确拼写其名称和路径名。（错误 3011）

我对 DoCmd.TransferDatabase 进行了很多试验，但找不到有效的设置。

由于自动增量字段，我没有测试任何“SELECT INTO”语句。

【问题讨论】：

SELECT ... INTO ... 和自动增量字段到底有什么问题？它通常对我很有用。
结果表中可能缺少主键、索引、默认值、引用是一个问题？
好吧，如果你想复制那些你需要比简单复制更高级的代码。您需要手动复制这些内容。
您不想从 Access 导出，而是从 SQL Server 导入。所以像DoCmd.TransferDatabase acImport, "ODBC", "your ODBC_String", ... 这样的东西可以工作。

标签： sql-server vba ms-access odbc

【解决方案1】：

你所问的可以像这样完成

CurrentDb.Execute "select * into localTable from dbo_serverTable" , dbFailOnError

要对所有表执行此操作，请使用此子

   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

【讨论】：

大家好，感谢您的帮助。现在我选择了这个解决方案，另外还有一个CREATE UNIQUE INDEX ID ON <Tablename> (<FirstField>) WITH PRIMARY。

【解决方案2】：

我做过类似的事情。将 ConnectionString 更改为您的环境。也许你必须扩展 TranslateDatatype 函数。

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

【讨论】：