Скопируйте связанную с ODBC SQL-таблицу в таблицу доступа с помощью VBA. - PullRequest
Новая
       46

Скопируйте связанную с ODBC SQL-таблицу в таблицу доступа с помощью VBA.

1 голос
/ 15 октября 2019

В моей базе данных Access есть несколько таблиц SQL-сервера, связанных с ODBC, которые являются производственной средой. Для тестирования я хочу скопировать все данные с SQL-сервера в идентичные по структуре таблицы Access, чтобы у меня был идентичный набор таблиц в среде разработки или тестирования. Чтобы сделать это трудным: все эти таблицы имеют идентификаторы автоинкремента, и я хочу, чтобы копии имели те же значения и, конечно, копируемое поле идентификатора также как и автоинкремент long.

Итак, набор этих таблиц:
- dbo_tbl_Abcd
- dbo_tbl_Efgh и т. д.

следует скопировать в:
- Dev_Abcd
- Dev_Efgh и т. д.

или в:
- Test_Abcd
- Test_Efgh и т. Д.

Когда я делаю ручное копирование и вставку для каждой таблицы, это будет работать без проблем. Появится диалоговое окно «Вставить таблицу как», где у вас есть опции:

Связанная таблица
Только структура
Структура и данные
Добавить данные в существующую таблицу

Когда вы установитеправильное имя и выберите Структура и данные, у вас будет правильная копия таблицы доступа с такими же значениями в поле Auto-ID. Я просто хочу сделать это по коду и для всех ODBC-таблиц одновременно (в цикле). Когда Access обеспечивает это ручное копирование, должен быть способ сделать это с помощью кода.

Я уже пробовал это: 

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

, но это только создаст больше ODBC-ссылок нате же таблицы SQL-сервера. Я также попробовал это: 

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

Это привело к следующей ошибке:
Механизм базы данных Microsoft Access не смог найти объект. Убедитесь, что объект существует, и что вы правильно написали его имя и путь. (Ошибка 3011)

Я много экспериментировал с DoCmd.TransferDatabase, но мне не удалось найти рабочую настройку.

Я не проверял никаких «SELECT INTO» -Statements из-заполе автоинкремента.

Ответы [ 2 ]

0 голосов
/ 16 октября 2019

То, что вы спрашиваете, может быть сделано как

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

И чтобы сделать это для всех таблиц, используйте этот 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
0 голосов
/ 15 октября 2019

Я сделал что-то похожее. Измените 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
...