' Перенос таблицы с MS-SQL в файл .MDB (имя MDB задано константой csDbPathName, MS-SQL - текущим подключением ADP-проекта)

'1) Вариант с DoCmd.TransferDatabase - перенос предварительно заполненной на сервере спец. таблицы с блокировкой таблицы
Public Function TransferDbTable_TransferDatabase(aTableName As String) As Boolean
  Dim HaveLock As Boolean
  On Error GoTo ErrorExit
  loi_WrLn "Перенос таблицы [" + aTableName + "]..."
  loi_IncLevel
  
  ' Перенос структуры
  HaveLock = GetAppLock("trtbl_" + aTableName, "Exclusive", "Session") >=  0 
  If Not HaveLock Then
    loi_IncLevel
    loi_WrLn "Ожидание доступа к таблице..."
    HaveLock = GetAppLock("trtbl_" + aTableName, "Exclusive", "Session",  5  *  1000 ) >=  0 
    If HaveLock Then
      loi_Wr "ОК."
    Else
      loi_WrLn "Не удается получить доступ к " + aTableName + "!"
    End If
    loi_IncLevel - 1 
  End If
  If HaveLock Then
     ' заполнение таблицы
     loi_WrLn "Перенос данных..."
     CurrentProject.Connection.Execute "dbo.M_" + aTableName + "_FillIn", , adCmdStoredProc + adExecuteNoRecords
     DoCmd.TransferDatabase _
      TransferType:=acExport, _
      DatabaseName:=csDbPathName, _ ' 
      DataBasetype:="Microsoft Access", _
      ObjectType:=acTable, _
      Source:="dbo." + aTableName, _
      Destination:=aTableName, _
      StructureOnly:=False
    ReleaseAppLock "trtbl_" + aTableName, "Session"
    loi_Wr "OK."
  End If
  
  TransferDbTable_TransferDatabase = True
  loi_IncLevel - 1 
  loi_WrLn "Перенос таблицы OK."
Exit Function
ErrorExit:
  LogVBAError Err, "TransferDbTable_TransferDatabase", aTableName
  On Error Resume Next
  loi_IncLevel - 1 
  loi_WrLn "Ошибка переноса таблицы" + aTableName + "!"
End Function

'-------------------------------------------------------------
'2) Вариант с DoCmd.TransferDatabase - перенос структуры предварительно созданной на сервере спец. таблицы + копирование данных через recordset.

Public Function TransferDbTable_RecordsetCopy(aTableName As String) As Boolean
On Error GoTo ErrorExit
  loi_WrLn "Перенос таблицы [" + aTableName + "]..."
  loi_IncLevel
  
  ' Перенос структуры
  loi_Wr "Перенос структуры..."
  DoCmd.TransferDatabase _
    TransferType:=acExport, _
    DatabaseName:=csDbPathName, _
    DataBasetype:="Microsoft Access", _
    ObjectType:=acTable, _
    Source:="dbo." + aTableName, _
    Destination:=aTableName, _
    StructureOnly:=True
  loi_WrLn "OK."
       
  loi_WrLn "Перенос данных..."
  ' Перенос данных
  Dim Src As ADODB.Recordset
  Dim Dst As ADODB.Recordset

 ' Открываем набор данных с источника (здесь открывается Представление)
  Set Src = New ADODB.Recordset
  With Src
    .CursorType = adOpenForwardOnly
    .LockType = adLockReadOnly
    .Open "dbo.M_" + aTableName, CurrentProject.BaseConnectionString, , , adCmdTable
  End With
  
 ' Открываем набор данных с назначения
  Set Dst = New ADODB.Recordset
  With Dst
    .CursorType = adOpenKeyset
    .LockType = adLockBatchOptimistic
    .CursorLocation = adUseClient
    .Open aTableName, dbPIConnection, , , adCmdTable
  End With
  
  ' Копируем данные
  Dim i As Long, f As String, flds() As String
  ReDim flds(Src.Fields.Count -  1 ) As String
  For i =  0  To Src.Fields.Count -  1 
    flds(i) = Src.Fields(i).Name
  Next
  While Not Src.EOF
    Dst.AddNew
    For i =  0  To Src.Fields.Count -  1 
      f = flds(i)
      Dst.Fields(f) = Src.Fields(f)
    Next
    Src.MoveNext
  Wend
  Dst.UpdateBatch
    
  Src.Close
  Dst.Close
  Set Src = Nothing
  Set Dst = Nothing
  loi_Wr "OK."
  
  TransferDbTable_RecordsetCopy = True
  loi_IncLevel - 1 
  loi_WrLn "Перенос таблицы OK."
Exit Function
ErrorExit:
  LogVBAError Err, "TransferDbTable_RecordsetCopy", aTableName
  On Error Resume Next
  loi_IncLevel - 1 
  loi_WrLn "Ошибка переноса таблицы" + aTableName + "!"
End Function