Microsoft Access - несколько транзакций при вставке в удаленную БД - PullRequest
Новая
       11

Microsoft Access - несколько транзакций при вставке в удаленную БД

0 голосов
/ 24 января 2012

В настоящее время я пытаюсь сделать несколько вставок из базы данных доступа на удаленный сервер SQL.Пока что мне не повезло.Когда я пытаюсь кодировать в рабочей области и транзакциях, я получаю ошибку несоответствия данных, но функционал insert отлично работает отдельно.

Вот мой код: Транзакция 1 закомментирована 

Private Sub cmdInsSqlSrvr_Click()
On Error GoTo ErrHandler

  Dim dbAccess As DAO.Database
  Dim strTableName As String
  Dim strSQL As String
  Dim strSqlServerDB As String
  Dim strTableName2 As String
  Dim cInTrans As Boolean
  Dim wsp As DAO.Workspace


  strTableName = "po_header_sql"
  strTableName2 = "po_line_Sql"

    '<configuration specific to SQL Server ODBC driver>
  strSqlServerDB = "ODBC;DRIVER={SQL Server};" & _
                   "Server=;" & _
                   "DATABASE=;" & _
                   "Uid=;" & _
                   "Pwd=;"


  'Start Transaction One
  'Set dbAccess = DBEngine(0)(0)

 ' strSQL = "INSERT INTO [" & strSqlServerDB & "].TABLE3 SELECT * FROM " & strTableName & ";"
  'dbAccess.Execute strSQL, dbFailOnError
  'InitConnect = True

  'MsgBox (dbAccess.RecordsAffected & " records have been moved from " & strTableName & " to remote DB")
  'Command9.SetFocus
  'cmdInsSqlSrvr.Enabled = False
  'cmdInsertTbl.Enabled = True

' End Transaction One

 'Begin Transaction Two

  Set wsp = DBEngine(0)(0)
  wsp.BeginTrans
  Set dbAccess = wsp(0)
  cInTrans = True

  strSQL = "INSERT INTO [" & strSqlServerDB & "].TABLE4 SELECT * FROM " & strTableName2 & ";"
  dbAccess.Execute strSQL, dbFailOnError
  InitConnect = True

  MsgBox (dbAccess.RecordsAffected & " records have been moved from " & strTableName & " to remote DB")
  wsp.CommitTrans
  cInTrans = False
   Command9.SetFocus
   cmdInsSqlSrvr.Enabled = False
   cmdInsertTbl.Enabled = True

'End Transaction Two

ExitProcedure:
  On Error Resume Next
  Set dbAccess = Nothing
Exit Sub

ErrHandler:
  InitConnect = False
  MsgBox Err.Description, vbExclamation, "Moving data to Sql Server failed: Error " & Err.Number
  Resume ExitProcedure

End Sub

1 Ответ

0 голосов
/ 24 января 2012

Исправлено, отделяя операторы вставки и помещая dbAccess.Execute после каждого. Также убрал код существенно. Код следует: 

Private Sub cmdInsSqlSrvr_Click()
On Error GoTo ErrHandler

  Dim dbAccess As DAO.Database
  Dim strTableName As String
  Dim strSQL As String
  Dim strSqlServerDB As String
  Dim strTableName2 As String

  strTableName = "po_header_sql"
  strTableName2 = "po_line_Sql"

    '<configuration specific to SQL Server ODBC driver>
  strSqlServerDB = "ODBC;DRIVER={SQL Server};" & _
                   "Server=<server ip>;" & _
                   "DATABASE=<database name>;" & _
                   "Uid=<database uid>;" & _
                   "Pwd=<database password>;"

  Set dbAccess = DBEngine(0)(0)

  strSQL = "INSERT INTO [" & strSqlServerDB & "].TABLE3 SELECT * FROM " & strTableName & ";"
  dbAccess.Execute strSQL, dbFailOnError

  MsgBox (dbAccess.RecordsAffected & " records have been moved from " & strTableName & " to remote DB")

  strSQL = "INSERT INTO [" & strSqlServerDB & "].TABLE4 SELECT * FROM " & strTableName2 & ";"
  dbAccess.Execute strSQL, dbFailOnError
  InitConnect = True

  MsgBox (dbAccess.RecordsAffected & " records have been moved from " & strTableName2 & " to remote DB")
   Command9.SetFocus
   cmdInsSqlSrvr.Enabled = False
   cmdInsertTbl.Enabled = True


ExitProcedure:
  On Error Resume Next
  Set dbAccess = Nothing
Exit Sub

ErrHandler:
  InitConnect = False
  MsgBox Err.Description, vbExclamation, "Moving data to Sql Server failed: Error " & Err.Number
  Resume ExitProcedure

End Sub
...