PLEASE: Need ADO and Access 2K help!!!!!

[JBG]

Bear with me while I describe my problem. And if you read all this, boy, you have my appreciation.

I have 2 Access 2K databases, I will call Access 1 and Access 2. Both are split, both are replicated (front end only).

I need to insert or update data that is in Access (backend)1 to Access (backend) 2, and update (not insert) data that is in Access 2 to Access 1.

I have a VB program on a 3 minute timer. I scrape Access 1 looking for flagged records. I then use ADO in the VB program to query Access 1, scoop up records that are flagged (these would consist of related records in 5 tables), then insert or update them to Access 2. Then I reverse the procedure and update Access 1 for records that are flagged in Access 2.

The idea is that as concurent users are in each db, as they do their daily tasks, I am always scrapping each db to populate the other so that data remains accurate between the 2

I know this is funky, but I am doing as I am told and need help. The idea is that ALL data in Access 1 should be accurate and up to date in Access 2 every 3 minutes, and vice versa.

I must use this system, or go to a shared back end between the 2 which causes a massive slow down and too many concurrent users. And no, I cannot go to SQL server for reasons out of my reach.

If I set flags in Access 1, close all forms, open Access 2 with all forms closed, the run the VB program manually, it works perfect (I am using ADO 2.5 with begintrans, committrans, etc., but not updadatebacth - I update one record at a time, then do committrans) After the program ends, I can see current data in Access 2. Then, if I set flags in Access 2 and run the VB program, once it ends, I can see accurate data in Access 1 that was just in Access 2.

The probelm is when i run the timer, and then play with each dtabase. As I open and close forms and manipulate data, and as the timer program runs, I am of course constantly updating and inserting into 2 Access backends, each from within Access as a user would do. However, during the updates and such in each backend, data is getting totally hosed as it seems that once ADO locks onto a table or tables, any data that is currently being written to the tables by the users is thrown away. ADO always seem to win, and the Access db that is trying to write to its own table at the time ADO is involved loses.

Lord, if this makes sense to anyone, please help this ADO novice.

Is is possible (and how would it be, if you know) to have ADO talking to Access, while simultaneously having Access write to its own tables? Would recset.UpdateBatch in the VB program help? Is there anything I can do that will allow this system to work? Am I WAY off base?

Thanks for reading this short novel...

JBG

 

[cmmrfrds]

Can you show the ADO connection strings. Also, all the parameters that are set on the connection and recordset objects. Show all the code for the update loop.

Is the problem that the Access updates to not take while the VB process is running?

Is the problem the same on Inserts and Updates?

Is the problem in one direction or both directions?

There is a good chance the batch update will be better since the transaction can be locked for a shorter duration.

What are you going to do if any of the updates fail in the batch?

 

[JBG]

Thank you for the reply.

In order:

1.

Private Sub ConnectToDBQ2()
            
            Set m_objCon = New ADODB.Connection
            strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info" & _
            "=False;Data Source=" & strDBpath & strDBname
            m_objCon.Open strCon
End Sub
Private Sub ConnectToDBQ3()
            
            Set m_objConQ3 = New ADODB.Connection
            strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info" & _
            "=False;Data Source=" & strDBpathQ3 & strDBnameQ3
            m_objConQ3.Open strCon
End Sub

2. Yes

3. Both

4. Oh boy. Here come the main process piece:

Private Sub DoTheUpdatesForQ3toQ2()
    
    Dim fso As New scripting.FileSystemObject
    Dim strCurrentFolderObject As String
    Dim strDrivepath As String
    Dim filFile As File
    Dim varDate As Variant
    Dim strDate As String
    Dim sValue As String
    Dim varPause As Variant
    Dim varStart As Variant
    Dim x As Integer
    Dim strAPPval As String
    Dim f1 As File
    Dim blnQ3setUpUpdateWentWell As Boolean
    Dim strID As String
    Dim blnAllQ2recsExist As Boolean
    Dim blnQ3recsExist As Boolean
    Dim blnQ3insertWentWell As Boolean
    Dim blnQ3UpdateWentWell As Boolean
    Dim z As Integer
    Dim blnTransIsOK As Variant
    Dim blnAllQ3recsExist As Boolean
    Dim blnQ2recsExist As Boolean
    Dim blnQ2UpdateWentWell As Boolean
    
            
            On Error GoTo errHandler
         
         
            ConnectToDBQ3
         
           m_rstMatch.Open "SELECT tblMatch.* FROM tblRunDetail INNER JOIN " & _
                            " (tblControl INNER JOIN tblMatch ON tblControl.ControlID " & _
                            " = tblMatch.CID) ON tblRunDetail.RunDetailID = tblMatch.RDID " & _
                            " WHERE tblMatch.blnQ2process=True " & _
                            " AND tblControl.blnIsLocked=False AND " & _
                            " tblRunDetail.blnIsLocked=False ", m_objConQ3, adOpenDynamic, adLockReadOnly
            
            If Not m_rstMatch.EOF Then
                WriteToLog "detail", vbCrLf & vbCrLf & "BEGIN Q2 UPDATE" & vbCrLf
                WriteToLog "detail", "CONNECT TO Q3 "
                WriteToLog "detail", "CONNECT TO Q2 "
                ConnectToDBQ2
                m_lngMatchID = 0
                m_lngQ2CID = 0
                m_lngQ2RDID = 0
                Do While Not m_rstMatch.EOF
                    m_lngQ3RDIDlast = m_rstMatch.Fields("RDID").Value
                    m_lngQ3CIDlast = m_rstMatch.Fields("CID").Value
                    m_lngMatchID = m_rstMatch.Fields("MatchID").Value
                    WriteToLog "detail", "*****> START PROCESS Q3 Match Table ID: " & m_lngMatchID
                    WriteToLog "detail", "GOTO GetQ3matchedID "
                    blnAllQ3recsExist = GetQ3matchedID
                    WriteToLog "detail", "RETURN FROM GetQ3matchedID "
                    If blnAllQ3recsExist = True Then
                        WriteToLog "detail", "GOTO CheckForExistingQ2recs"
                        blnQ2recsExist = CheckForExistingQ2recs
                        WriteToLog "detail", "RETURN FROM CheckForExistingQ2recs"
                        If blnQ2recsExist = True Then
                            WriteToLog "detail", "GOTO UpdateQ2 - UPDATE"
                            blnQ2UpdateWentWell = UpdateQ2(False)
                            WriteToLog "detail", "RETURN FROM UpdateQ3"
                            If blnQ2UpdateWentWell = False Then
                                m_objCon.RollbackTrans
                                WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: UpdateQ3 - INSERT&quot;
                                Exit Sub
                            Else
                                m_objCon.CommitTrans
                            End If
                        Else
                            
                            'error
                            WriteToLog &quot;detail&quot;, &quot;GOTO UpdateQ2 -  UPDATE&quot;
                            blnQ2UpdateWentWell = UpdateQ2(False)
                            If blnQ2UpdateWentWell = False Then
                                m_objCon.RollbackTrans
                                WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: UpdateQ3 - UPDATE&quot;
                                Exit Sub
                            Else
                                m_objCon.CommitTrans
                            End If
                        End If
                        KillRecSets
                    Else
                        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: GetQ2matchedID&quot;
                    End If
                    If Not m_rstMatch.EOF Then m_rstMatch.MoveNext
                Loop
                
                If m_objCon.State = adStateOpen Then
                    m_objCon.Close
                    Set m_objCon = Nothing
                    WriteToLog &quot;detail&quot;, &quot;Q3 CONNECTION CLOSED&quot;
                End If
            End If
            m_rstMatch.Close
            Set m_rstMatch = Nothing
            If m_objConQ3.State = adStateOpen Then
                Set m_objConQ3 = Nothing
                WriteToLog &quot;detail&quot;, &quot;Q3 CONNECTION CLOSED&quot;
            End If
            WriteToLog &quot;detail&quot;, vbCrLf & vbCrLf & &quot;****************END UPDATE**********************&quot;
            
            Exit Sub
errHandler:
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: &quot; & Err.Number & &quot; &quot; & Err.Description
        WriteToLog &quot;detail&quot;, vbCrLf & &quot;END UPDATE &quot;
 
        
                      
End Sub

Here is the main loop that populates recordsets:

Private Function UpdateQ2(ByVal blnIsAnInsert As Boolean) As Boolean
    
    Dim rstRDQ2 As ADODB.Recordset
    Dim rstMatchX As ADODB.Recordset
    Dim rstExceptQ2 As ADODB.Recordset
    Dim rstControlQ2 As ADODB.Recordset
    Dim x As Integer
    Dim blnPopulateQ2contWentWell As Boolean
    Dim blnPopulateQ2CAwentWell As Boolean
    Dim varRepdate As Variant
    Dim varDataFileName As Variant
    Dim rstDoesTheNewFileExist As ADODB.Recordset
    Dim lngTempCID As Long
    Dim lngTempRDID As Long

        
        On Error GoTo errHandler
        blnIsAnInsert = False
        Set rstDoesTheNewFileExist = New ADODB.Recordset
        m_objCon.BeginTrans
        If m_lngQ3RDIDlast <> m_lngRDID Or blnIsFirstTime = True Then
            'rd insert comin' up
            m_lngRDID = m_lngQ3RDIDlast
            Set rstRDQ2 = New ADODB.Recordset
            rstRDQ2.Open &quot;tblRundetail&quot;, m_objCon, adOpenDynamic, adLockOptimistic
            If blnIsAnInsert = True Then
                rstRDQ2.AddNew
            Else
                rstRDQ2.Filter = &quot;RundetailID = &quot; & m_rstRD.Fields(&quot;RunDetailID&quot;).Value
            End If
            m_lngQ3RDID = m_rstRD.Fields(&quot;RunDetailID&quot;).Value
            For x = 0 To m_rstRD.Fields.Count - 1
                If Not IsThisAbadField(m_rstRD.Fields(x).Name) Then
                    If Not m_rstRD.Fields(x).Name = &quot;RunDetailID&quot; Then
                        'rstRDQ2.Fields(&quot;RundetailID&quot;).Value = m_rstRD.Fields(x).Value
                        'Else
                        If m_rstRD.Fields(x).Name = &quot;DataFileName&quot; Then
                            varDataFileName = m_rstRD.Fields(x).Value
                        ElseIf m_rstRD.Fields(x).Name = &quot;RepDate&quot; Then
                            varRepdate = m_rstRD.Fields(x).Value
                        End If
                        rstRDQ2.Fields(m_rstRD.Fields(x).Name).Value = m_rstRD.Fields(x).Value
                    End If
                End If
            Next
            rstRDQ2.Fields(&quot;blnIHaveControl&quot;).Value = True
            rstRDQ2.Fields(&quot;Match&quot;).Value = False
            rstRDQ2.Fields(&quot;blnIsOrphan&quot;).Value = False
            rstRDQ2.Update
            m_lngQ2RDID = rstRDQ2.Fields(0).Value

            WriteToLog &quot;detail&quot;, &quot;UPDATE RD REC - Q3 RDID: &quot; & _
                        m_rstRD.Fields(&quot;RunDetailID&quot;).Value & &quot; &quot; & &quot;File Name: &quot; & varDataFileName & &quot; &quot; & _
                        &quot;Repdate: &quot; & varRepdate
        
            Set rstExceptQ2 = New ADODB.Recordset
            m_rstExcept.MoveFirst
            rstExceptQ2.Open &quot;tblExceptRpt&quot;, m_objCon, adOpenDynamic, adLockOptimistic
            Do While Not m_rstExcept.EOF
                If blnIsAnInsert = True Then
                    rstExceptQ2.AddNew
                Else
                    rstExceptQ2.Filter = &quot;ExceptID =&quot; & m_rstExcept.Fields(&quot;ExceptID&quot;).Value
                End If
                rstExceptQ2.Fields(&quot;RunDetailID&quot;).Value = m_lngQ3RDID
                For x = 0 To m_rstExcept.Fields.Count - 1
                    If Not IsThisAbadField(m_rstExcept.Fields(x).Name) Then
                        If Not m_rstExcept.Fields(x).Name = &quot;ExceptID&quot; Then
                            'rstExceptQ2.Fields(&quot;ExceptID&quot;).Value = m_rstExcept.Fields(x).Value
                        'Else
                            If Not m_rstExcept.Fields(x).Name = &quot;RunDetailID&quot; Then
                                rstExceptQ2.Fields(m_rstExcept.Fields(x).Name).Value = m_rstExcept.Fields(x).Value
                            End If
                        End If
                    End If
                Next
                rstExceptQ2.Update
                WriteToLog &quot;detail&quot;, &quot;ADD EXCEPT REC - Q2 EXCEPT ID: &quot; & m_rstExcept.Fields(&quot;ExceptID&quot;).Value
                blnPopulateQ2contWentWell = PopulateQ2Cont(rstExceptQ2.Fields(&quot;ExceptID&quot;).Value, blnIsAnInsert)
                If blnPopulateQ2contWentWell = False Then
                    UpdateQ2 = False
                    rstRDQ2.Close
                    Set rstRDQ2 = Nothing
                    rstExceptQ2.Close
                    Set rstExceptQ2 = Nothing
                    Exit Function
                End If
                m_rstExcept.MoveNext
            Loop
            rstRDQ2.Close
            Set rstRDQ2 = Nothing
            rstExceptQ2.Close
            Set rstExceptQ2 = Nothing
        End If
            
        'control insert comin' up
        
        If m_lngQ3CIDlast <> m_lngCID Or blnIsFirstTime = True Then
            m_lngCID = m_lngQ3CIDlast
            Set rstControlQ2 = New ADODB.Recordset
            rstControlQ2.Open &quot;tblControl&quot;, m_objCon, adOpenDynamic, adLockOptimistic
            If blnIsAnInsert = True Then
                rstControlQ2.AddNew
            Else
                rstControlQ2.Filter = &quot;ControlID = &quot; & m_rstControl.Fields(&quot;ControlID&quot;).Value
            End If
            m_lngQ3CID = m_rstControl.Fields(&quot;ControlID&quot;).Value
            For x = 0 To m_rstControl.Fields.Count - 1
                If Not IsThisAbadField(m_rstControl.Fields(x).Name) Then
                    If Not m_rstControl.Fields(x).Name = &quot;ControlID&quot; Then
                        rstControlQ2.Fields(m_rstControl(x).Name).Value = m_rstControl.Fields(x).Value
                    End If
                End If
            Next
            rstControlQ2.Fields(&quot;blnIHaveControl&quot;).Value = True
            rstControlQ2.Fields(&quot;Match&quot;).Value = False
            rstControlQ2.Fields(&quot;blnIsOrphan&quot;).Value = False
            rstControlQ2.Update
            m_lngQ2CID = rstControlQ2.Fields(0).Value

            WriteToLog &quot;detail&quot;, &quot;ADD CONTROL REC - Q3 ID: &quot; & m_rstControl.Fields(&quot;ControlID&quot;).Value
            blnPopulateQ2CAwentWell = PopulateQ2CA(m_lngQ3CID, blnIsAnInsert)
            If blnPopulateQ2CAwentWell = False Then
                UpdateQ2 = False
                Exit Function
            End If
            rstControlQ2.Close
            Set rstControlQ2 = Nothing
        End If
        blnIsFirstTime = False
        'match insert comin' up
        

        m_objCon.Execute (&quot;DELETE * FROM &quot; & _
                        &quot; tblMatch WHERE RDID = &quot; & m_rstMatch.Fields(&quot;RDID&quot;).Value & &quot; AND &quot; & _
                        &quot; CID = &quot; & m_rstMatch.Fields(&quot;CID&quot;).Value)
         
        Set rstDoesTheNewFileExist = Nothing
        UpdateQ2 = True

        Exit Function

errHandler:
        
        UpdateQ2 = False
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: &quot; & Err.Number & &quot; &quot; & Err.Description
        Exit Function

End Function

And here are my connection events:

Private Sub m_objCon_CommitTransComplete(ByVal pError As ADODB.Error, _
                adStatus As ADODB.EventStatusEnum, _
                ByVal pConnection As ADODB.Connection)
    
    If adStatus = adStatusErrorsOccurred Then
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: CommitTrans for Q2: &quot; & m_lngMatchID & &quot; - &quot; & pError.Description
        m_objCon.RollbackTrans
    Else
        m_objConQ3.BeginTrans
        m_objConQ3.Execute (&quot;UPDATE tblRunDetail SET blnIhavecontrol = false WHERE RunDetailID = &quot; & m_lngQ3RDIDlast)
        m_objConQ3.Execute (&quot;UPDATE tblControl SET blnIhavecontrol = false WHERE ControlID = &quot; & m_lngQ3CIDlast)
        m_objConQ3.CommitTrans
    End If
    

End Sub
Private Sub m_objCon_RollbackTransComplete(ByVal pError As ADODB.Error, _
   adStatus As ADODB.EventStatusEnum, _
   ByVal pConnection As ADODB.Connection)


    If adStatus = adStatusOK Then
        WriteToLog &quot;detail&quot;, &quot;ROLLBACKTRANSCOMPLETE Q2: &quot; & m_lngMatchID
    Else
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: RollbackTrans for Q2: &quot; & m_lngMatchID & &quot; - &quot; & pError.Description
    End If
    

End Sub

Private Sub m_objConQ3_CommitTransComplete(ByVal pError As ADODB.Error, _
                adStatus As ADODB.EventStatusEnum, _
                ByVal pConnection As ADODB.Connection)
    
    If adStatus = adStatusErrorsOccurred Then
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: CommitTrans for Q3: &quot; & m_lngMatchID & &quot; - &quot; & pError.Description
        MsgBox pError.Description
        m_objConQ3.RollbackTrans
    Else
        
        WriteToLog &quot;detail&quot;, &quot;COMMITTRANSCOMPLETE FOR Q3: &quot; & m_lngMatchID
    End If
    

End Sub
Private Sub m_objConQ3_RollbackTransComplete(ByVal pError As ADODB.Error, _
   adStatus As ADODB.EventStatusEnum, _
   ByVal pConnection As ADODB.Connection)


    If adStatus = adStatusOK Then
        WriteToLog &quot;detail&quot;, &quot;ROLLABACKTRANSCOMPLETE: &quot; & m_lngMatchID
    Else
        WriteToLog &quot;detail&quot;, &quot;>>>ERROR<<<: RollbackTrans for Q3: &quot; & m_lngMatchID & &quot; - &quot; & pError.Description
    End If
    
End Sub

There is much more to the code, but these are the main chunks. The code above exists in a class only so I can use WithEvents. As you can, I am NOT an OO progammer...

If you can sort thru thur this, wow....

If not, any thoughts would be great.

Thanks again,

JBG

 

[cmmrfrds]

A couple of questions as I am done for the day.

There are a number of recordsets open and wrapped in the same transaction. Is this necessary?

I noticed all the recordsets are opened dynamic. Is this really necessary? Why?

How many records are typically updated in 1 session. Is there 10, 100, 1000??? This will impact the solution.

Good night.

 

[JBG]

To anser your first question:

I do not want to update one backend unelss the other is done correctly. Otherwise, there will be un-sybced data. Therefore, I only update one after the other has gone well.

I opened them dynamic to see if it would work,. I had tried other properties and reached that stage....

the number of records would, at most several hundred at one time...

Thank u for your time

JBG

 

[cmmrfrds]

Opening dynamic will allow you to catch deletes and updates on the access side prior to starting the begin tran, most of the processing is done after the begin tran so I don't see the advantage for the extra overhead. You need to have a cutoff at some point in time! Why not as soon as the process starts that will allow you to use a static client side cursor which I believe will be more efficient in this case. If a record is deleted on 1 side, how do you populate the delete over to the other side. Is that the match logic in the vba code?

What are you going to do, if a record was deleted from the access side after the start of the tran but before the commit on the tran? Similiar on the update side?

It is probably worth.
(1) Establish cutoff prior to starting the process.
(2) Use static client side cursor.
(3) Do not start the transaction until the batches are ready.
(4) Batch update inside the transaction.

 

[JBG]

Records are never deleted on either side, fortunatley. All of the data steams into Access 1 and cannot be deleted (only archived, but that is another matter).

I agree. I thought about the cutoff too. As soon as I have scraped data from , say, Access 1, end the conection (maybe use a disconnected rec set).

Here is the essence of my current dilemma:

As users are updating Access 1, and then my VB program hits their backend at the same time, is there any way to allow BOTH sides to win? That is, if the VB program hits table A at the exact time that a user is updating it, someone hs to lose, yes? Is there a way that on the Access side that their update will take place/continue after my VB program leaves the scene?


Also, I have not used UpdateBatch before. does it look like this?:

objCon.beginTrans
rst.open a rec set
for x = 0 to 4
rst.addnew
For some loop
Poupalate.field = WithThis this
next
next
rst.UpdateBatch (I should have 5 newly populated recs)
objCon.commitrans


In general, sorry to repeat myself, and I will implement your comments asap.

JBG

 

[cmmrfrds]

rst.LockType = adLockBatchOptimistic
rst.open a rec set
''-disconnect and do the updates in memory
Set rst.ActiveConnection = Nothing
for x = 0 to 4
rst.addnew
For some loop
Poupalate.field = WithThis this
next
next
''- reconnect
rst.ActiveConnection = your connection
objCon.beginTrans
rst.UpdateBatch (I should have 5 newly populated recs)
objCon.commitrans

'- if you want it is possible to do some post processing before the commit trans. ADO flags the recordset with status information which is available on each record. For example, there are a number of filters that can be set.

rst.Filter = adFilterAffectedRecords '- check for # updates
If rst.RecordCount = 0 then
no records affected
end if
rst.Filter = adFilterNone '- turn off filter
rst.Filter = adFilterConflictingRecords
If rst.RecordCount = 0 then
no record conflicts
end if
rst.Filter = adFilterNone '- turn off filter

The is an option to do record level locking in Access. I believe the default is page level and that is probably why you are having the conflicts. I would need to research. Do a post i.e. "How to turn on record level locking"

 

[cmmrfrds]

JBG, the more I think about it, I don't think that Access will release the lock until the batch is complete. The key is to keep the batch small with no intervening processes between the begin and end tran.

 

[JBG]

I already did the rec vs. page level to no avail. (Tools/Options/Advanced, then lower right for check boxes) But that with my goofy ADO.

Now that you have given me far more to work with, I hope to get this thing to work.

I dont know who you are, masked code man, but this ADo novice appreciates your time and effort.

I will post back if I get this thing to work....

JBG