帮我看看事务提交出错

代码如下：Dim Db As ADODB.Connection
Dim AccessDb As ADODB.Connection
Dim lDb As ADODB.Connection
Dim mDb As ADODB.Connection
Dim AccRs As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim lrs As ADODB.Recordset
Dim ars As ADODB.Recordset
Dim ConnectStr As String
Dim lConnectStr As String
Dim AccConnectStr As String
Dim SqlCount As Long  '存放本地SqlServer数据库的记录条数
Dim AccCount As Long  '存放Access数据库的记录条数
Dim lCount As Long    '省公司SqlServer数据库的记录条数
Dim i As Long         '时间参数，设置多少时间更新记录一次
Dim Strr As String
Dim stmp As String '存放更新的数据
Dim StrSql As StringPrivate Sub Form_Load()
  On Error GoTo MyErr

  ConnectStr = "Provider=MSDASQL;DSN=youku;UID=jyxy;PWd=8040583;"
  Set Db = New ADODB.Connection
  Db.CursorLocation = adUseClient
  Db.ConnectionTimeout = 10
  Db.IsolationLevel = adXactIsolated
  Db.Open ConnectStr

''  ' Access数据库位置,实施的时候，需要改变
''  AccConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\tankdata.mdb;"
''  Set AccessDb = New ADODB.Connection
''  AccessDb.CursorLocation = adUseClient
''  AccessDb.ConnectionTimeout = 10
''  AccessDb.IsolationLevel = adXactIsolated
''  AccessDb.Open AccConnectStr
  lConnectStr = "Privider =MSDASQL;DSN=zjsy_oil;UID=zjsy_oil;PWD=zjsy_oil;"
  Set lDb = New ADODB.Connection
  lDb.CursorLocation = adUseClient
  lDb.ConnectionTimeout = 10
  lDb.IsolationLevel = adXactIsolated
  lDb.Open lConnectStr


  lConnectStr = "Privider =MSDASQL;DSN=zjsy_oil;UID=zjsy_oil;PWD=zjsy_oil;"
  Set mDb = New ADODB.Connection
  mDb.CursorLocation = adUseClient
  mDb.ConnectionTimeout = 10
  mDb.IsolationLevel = adXactIsolated
  mDb.Open lConnectStr

  Set rs = New ADODB.Recordset
  Set lrs = New ADODB.Recordset
  Set ars = New ADODB.Recordset
  i = 0  '初始化时间参数

  Exit Sub


MyErr:
MsgBox "连接数据库失败，请检查原因！"


End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Set Db = Nothing
  Set lDb = Nothing
  Set rs = Nothing
  Set lrs = Nothing

End SubPrivate Sub Timer1_Timer()
On Error GoTo MyErri = i + 1
'实施时改变，多少时间更新数据一次
If i = 90 Then
     StrSql = "select * from J854_Dyna_Data"
     rs.Open StrSql, Db, adOpenStatic, adLockOptimistic
     SqlCount = rs.RecordCount
     rs.Close

     StrSql = "select * from TB_Storage_TankData"
     lrs.Open StrSql, lDb, adOpenStatic, adLockOptimistic
     lCount = lrs.RecordCount
     lrs.Close

    '判断是否已提取SqlServer中所有记录
    '如没有提全，则删除省公司SQL中记录，重新提取
    If lCount < SqlCount Then
     mDb.BeginTrans
     If lCount <> 0 Then
            Strr = "  Delete From TB_Storage_TankData"
            lDb.Execute Strr
      End If

      Strr = "select * From J854_Dyna_Data"
      rs.Open Strr, Db, adOpenStatic, adLockOptimistic

      Strr = "select * from TB_Storage_TankData"
      lrs.Open Strr, lDb, adOpenStatic, adLockOptimistic
      rs.MoveFirst
      For j = 1 To SqlCount
          Strr = "select * from jyg where 罐号='" + rs!TankNo + "'"

          ars.Open Strr, Db, adOpenStatic, adLockOptimistic
          i = ars.RecordCount


          With lrs
               .AddNew
               .Fields("TankNo").Value = rs!TankNo
               .Fields("TotalLevel").Value = Format(CSng(Val(rs!Oil_Level)), "#.000")
               .Fields("WaterLevel").Value = Format(CSng(Val(rs!Water_Level)), "#.000")
               .Fields("Weight").Value = rs!Weight
               .Fields("DensitySTD").Value = Format(CSng(Val(rs!Density_Std)), "#.0")
               .Fields("Temperature").Value = Format(CSng(Val(rs!Temperature)), "#.00")
               .Fields("TankStatus").Value = rs!Tank_Status
               .Fields("NetVolume").Value = rs!Net_Volume
               .Fields("WaterVolume").Value = rs!Water_Volume
               .Fields("UpDateTime").Value = rs!Time

               .Fields("TankHeight").Value = Format(CSng(Val(ars!参照高度)) / 1000, "#.000")
               .Fields("MinHeight").Value = Format(CSng(Val(ars!下限)), "#.000")
               j = Format(CSng(Val(ars!下限)), "#.000")
               .Fields("TankVolume").Value = Format(CSng(Val(ars!总容量)), "#.000")

               .Fields("OilName").Value = ars!油品

               '油库代码实施的时候，需要改变,现在为空。
               .Fields("StorageID").Value = ""
               .Update
         End With
         rs.MoveNext
         ars.Close
      If j > SqlCount Then Exit For
      Next j
      mDb.CommitTrans
      rs.Close
      lrs.Close

    '如已经全部提取，则更新所有数据
    Else
        Strr = "select * from J854_Dyna_Data order by TankNO"
        rs.Open Strr, Db, adOpenStatic, adLockOptimistic
        rs.MoveFirst

        mDb.BeginTrans
        For k = 1 To SqlCount
            stmp = ""
            'stmp = stmp + "TotalLevel=" + Str(rs!Oil_Level)
            stmp = stmp + "TotalLevel=" + Format(CSng(Val(rs!Oil_Level)), "#.000")            'stmp = stmp + ",WaterLevel=" + Str(rs!Water_Level)
            stmp = stmp + ",WaterLevel=" + Format(CSng(Val(rs!Water_Level)), "#.000")
            stmp = stmp + ",Weight=" + Str(rs!Weight)
            'stmp = stmp + ",DensityStd=" + Str(rs!Density_Std)
            stmp = stmp + ",DensityStd=" + Format(CSng(Val(rs!Density_Std)), "#.0")

            'stmp = stmp + ",Temperature=" + Str(rs!Temperature)
            stmp = stmp + ",Temperature=" + Format(CSng(Val(rs!Temperature)), "#.00")
            stmp = stmp + ",TankStatus='" + rs!Tank_Status + "'"
            stmp = stmp + ",NetVolume=" + Str(rs!Net_Volume)
            stmp = stmp + ",WaterVolume=" + Str(rs!Water_Volume)
            stmp = stmp + ",UpDateTime='" + Format(rs![Time], "yyyy-mm-dd hh:mm:ss") + "'"

            stmp = "update  TB_Storage_TankData set " + stmp + " where TankNo='" + rs!TankNo + "'"

            lDb.Execute stmp

            rs.MoveNext
            If k > SqlCount Then Exit For
        Next k
        mDb.CommitTrans
        rs.Close


    End If
'更新数据完，时间参数初始化
i = 0End IfExit SubMyErr:
     mDb.RollbackTrans
     MsgBox "更新数据出错,请检查原因!"End Sub
提交事务的时候，说是没有活动事务
就出错了

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

mDb.BeginTrans
mDb.CommitTrans改为lDb.BeginTrans
lDb.CommitTrans
mdb 和 ldb 都没有用具体出错在FOR 循环这里如果本地数据库有两条记录的话，当FOR循环I=3的时候，执行FOR语句就出错了跳到出错处理了。执行mDb.RollBackTrans 这个语句的时候说没有“活动事务”