Microsoft Access - 插入远程数据库时的多个事务

时间:2012-01-24 01:44:18

标签: sql ms-access vba transactions access-vba

我正在尝试从访问数据库到远程sql server进行多次插入。到目前为止,我没有运气。当我尝试在工作空间和事务中编码时,我收到数据不匹配错误,但功能insert分别完全正常。

以下是我的代码:事项一已被注释掉

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 :(得分:0)

通过分离insert语句并在每个语句之后放置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