Help! pls comment on my ADODB.connection

[lok1234]

Dear all,

Some of my users complains that if they have used my program for a long time (let say, 45 minutes) and do a lot of transactions, my program will have error messages prompted up and closed the program abnormally (sorry, they even have no time to capture the error messages). And what they have input even been "rollback". But actually, my program has already handled the transaction. (I have coded my program with begintrans, committrans and rollbacktrans if have error)

The background of my program is, I am using VB6 and Access database which store in a common share drive. frankly speaking, there are a lot of mass update, mass insert within a transaction in the program. (You may refer to one of my written function as belows)

I am not sure if there should have special handling for dealing a "big" transaction. Besides, I have a lot of recordsets for displaying data in the mshflexgrids at the same time. Again, I don't know if this has impact to the program.

The following codes are my general (or generic) codes for the ADODB connection. An example of my transaction is also included too.

Please comments for my codes if it has potential risk or can handle transaction better.. Many thanks.

'declare

Public gConnect_Access As ADODB.Connection

'Function for open Recordset or Table

Public Function f_OpenSQLrs(ByRef pRs As ADODB.Recordset, pSQLTable As String, _
                            pType As Integer, pConnection As ADODB.Connection, _
                            ByVal pCursorLocation, ByVal pCursorType, Optional ByVal pLocktype = adLockOptimistic) As Boolean
On Error GoTo Exception
    Set pRs = New ADODB.Recordset
    pRs.CursorLocation = pCursorLocation
    pRs.CursorType = pCursorType 'adOpenForwardOnly ' adOpenKeyset
    pRs.LockType = pLocktype 'adLockReadOnly
    pConnection.CommandTimeout = 3600
    pRs.Open pSQLTable, pConnection, , , pType
    f_OpenSQLrs = True

Exit Function
Exception:
    MsgBox Err.Description, vbCritical
    f_OpenSQLrs = False
    Exit Function
End Function

'Function for closing the recordset

Public Function fn_closeADOrs(pRs As ADODB.Recordset)
On Error GoTo Err
If Not pRs Is Nothing Then
    If pRs.State = 1 Then
        pRs.Close: Set pRs = Nothing
    End If
End If
Exit Function
Err:
    'MsgBox Err.Description, vbCritical
    Resume Next
    'Set pRs = Nothing
    Exit Function
End Function

'An example of my big transaction

Dim aStrsql As String
Dim aRs As New ADODB.Recordset
Dim aRs2 As New ADODB.Recordset

gConnect_Access.BeginTrans

str_SQL = " insert into TableA ..."
gConnect_Access.Execute str_SQL
                    
str_SQL = " insert into TableB ..."
gConnect_Access.Execute str_SQL

str_SQL = " select ... from TableC ...where ..."

If f_OpenSQLrs(aRs, str_SQL, adCmdText, gConnect_Access, adUseClient, adOpenKeyset) Then
      i = 0
      While Not aRs.EOF
            str_SQL = " insert into TableD ..."
            gConnect_Access.Execute str_SQL

            aRs.MoveNext
      Wend
      Call fn_closeADOrs(aRs)
Else
      GoTo Err
End If
                        
str_SQL = " select ... from TableE ...."

If f_OpenSQLrs(aRs, str_SQL, adCmdText, gConnect_Access, adUseClient, adOpenKeyset) Then
      i = 0
      While Not aRs.EOF
                str_SQL = " select ... from TableF ..."
 
                If f_OpenSQLrs(aRs2, str_SQL, adCmdText, gConnect_Access, adUseClient, adOpenKeyset) Then
                   While Not aRs2.EOF
                         .....
                         aRs2.MoveNext
                   Wend
                   Call fn_closeADOrs(aRs2)
                Else
                   MsgBox ("XXX cannot be found!"), vbCritical
                   'GoTo Err
                End If
              
                 str_SQL = " Update ..."
                 gConnect_Access.Execute str_SQL
          i = i + 1
          aRs.MoveNext
      Wend
      Call fn_closeADOrs(aRs)
Else
      GoTo Err
End If

  str_SQL = " insert into .."
  gConnect_Access.Execute str_SQL

  str_SQL = " select ..."

  If f_OpenSQLrs(aRs, str_SQL, adCmdText, gConnect_Access, adUseClient, adOpenKeyset) Then
        i = 0
        While Not aRs.EOF
              aRs!Field1 = ...
              aRs.Update
              i = i + 1
              aRs.MoveNext
        Wend
        Call fn_closeADOrs(aRs)
  Else
        GoTo Err
  End If

gConnect_Access.CommitTrans

Exit Function

Err:
  MsgBox Err.Description, vbCritical, Err.Source
  gConnect_Access.RollbackTrans
  Call fn_closeADOrs(aRs)
End Function