• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 212
  • Last Modified:

ADO Efficient File Handling?

I have a written a function in my most recent client application.  It works well but is executing very slowly on the client network and I am wondering if I can improve the performance.  I will give an example of what I am doing.  The pseudo code is in the code window under the heading 'as it is".  In reality there are more levels of tables and functions.

Function 1 loops thru table1.  For each record in table1 it calls a function which loops thru all records in table 2 linked to table1.

The Primary Key in table1 is a field called 'ID".  The linking field in table2 is called 'table1ID'.

Each of the functions defines a recordset, opens the recordset with the appropriate sql statement, then closes and sets to nothing the recordset before the function terminates.

This isn't so bad on the upper level function since it only establishes and opens the recordset once.  But function 2 is called for every one of the thousands of record in  table1. This means that the cycle of defining , opening, processing and closing the recordset happens thousand of times.  Is there any way to make this more efficient?

It seems terribly inefficient to dim, set, open, process and close rstbl2 for every record in rstbl1/

As shown in the code under the heading "Will this work?" Is it possible to move the statements:

Dim rstbl2 As ADODB.Recordset
Set rstbl2 = New ADODB.Recordset

to function1 and only execute the statements to open and close the rstbl2  in function2?

Any ideas to improve the efficiency are welcome.
"As it is"

public Function function1 (passedPropID as long) as double

sqlString = "Select * from table1 where PropID = passedpropid

'
Dim rstbl1 As ADODB.Recordset
Set rstbl1 = New ADODB.Recordset
rstbl1.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rstbl1.EOF Then
Else
    If rstbl1.RecordCount > 0 Then
        '
        rstbl1.MoveFirst
        While Not rstbl1.EOF
            '
            Function2 (rstbl1!ID)

            rstbl1.MoveNext
        Wend
    End If
End If
'
rstbl1.Close
Set rstbl1 = Nothing
'
end function

Private function function2 (passedID as long)
sqlString = "Select * from table2 where table1id = passedid

Dim rstbl2 As ADODB.Recordset
Set rstbl2 = New ADODB.Recordset
rstbl2.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rstbl2.EOF Then
Else
    If rstbl2.RecordCount > 0 Then
        '
        rstbl2.MoveFirst
        While Not rstbl2.EOF
            '
            'do something here

            rstbl2.MoveNext
        Wend
    End If
End If
'
rstbl2.Close
Set rstbl2 = Nothing
'
end function

Will this work?" ////////////////////////////////////

public Function function1 (passedPropID as long) as double

sqlString = "Select * from table1 where PropID = passedpropid
'
Dim rstbl2 As ADODB.Recordset
Set rstbl2 = New ADODB.Recordset
'
Dim rstbl1 As ADODB.Recordset
Set rstbl1 = New ADODB.Recordset
rstbl1.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rstbl1.EOF Then
Else
    If rstbl1.RecordCount > 0 Then
        '
        rstbl1.MoveFirst
        While Not rstbl1.EOF
            '
            Function2 (rstbl1!ID)

            rstbl1.MoveNext
        Wend
    End If
End If
'
rstbl1.Close
Set rstbl1 = Nothing
'
Set rstbl2 = Nothing
'
end function

Private function function2 (passedID as long)
sqlString = "Select * from table2 where table1id = passedid


rstbl2.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rstbl2.EOF Then
Else
    If rstbl2.RecordCount > 0 Then
        '
        rstbl2.MoveFirst
        While Not rstbl2.EOF
            '
            'do something here

            rstbl2.MoveNext
        Wend
    End If
End If
'
rstbl2.Close

'
end function

Open in new window

0
mlcktmguy
Asked:
mlcktmguy
  • 3
  • 2
1 Solution
 
mlcktmguyAuthor Commented:
I created a test to see if the recordset definitions could be moved.  The code is in the code window.

I execute testfilehandling1 from another form.

Based on the debug prints it goes thru the first 14 records of Namefile and then stops in function 'testfilehandling2' on the statement

rsTax.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

with the message '3705' operation is not allowed when the object is open.  Why would this work the first 14 times thru testfilehandling2 and stop on the 15th record.  I ran it several times and it always stops on the 15th record.
Option Compare Database

Option Explicit
'
Dim selectString As String
Dim rsTax As ADODB.Recordset
'
Public Function testfilehandling1()
'
Set rsTax = New ADODB.Recordset
'
Dim numTaxRecs As Long
Debug.Print "Start"; Now()
'
selectString = "Select * From tblNameFile "
'
Dim rsName As ADODB.Recordset
Set rsName = New ADODB.Recordset
rsName.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsName.EOF Then
    Exit Function
Else
    If rsName.RecordCount > 0 Then
        '
        rsName.MoveFirst
        While Not rsName.EOF
           '
           numTaxRecs = testfilehandling2(Nz(rsName!ID, 0))
           Debug.Print "NameRecID: "; Nz(rsName!ID, 0); " Num Tax Recs: "; Trim(Str(numTaxRecs))
           '
           rsName.MoveNext
        Wend
    End If
End If
'
rsName.Close
Set rsName = Nothing
'
Set rsTax = Nothing
'
Debug.Print "End  "; Now()
End Function

Public Function testfilehandling2(passedID As Long) As Long
'
testfilehandling2 = 0
'
selectString = "Select * From tblTaxRecs Where [NameFileRecID] = " & passedID
rsTax.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsTax.EOF Then
    Exit Function
Else
    If rsTax.RecordCount > 0 Then
        '
        rsTax.MoveFirst
        While Not rsTax.EOF
            '
            testfilehandling2 = testfilehandling2 + 1
            testfilehandling3 (Nz(rsTax!ID, 0))
            '
            rsTax.MoveNext
        Wend
    End If
End If
'
rsTax.Close
'
End Function
Public Function testfilehandling3(passedID As Long) As Long
'
testfilehandling3 = 0
'
selectString = "Select * From tblPayments_Year_Sub Where [TaxRecID] = " & passedID
'
Dim rsPay As ADODB.Recordset
Set rsPay = New ADODB.Recordset
rsPay.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsPay.EOF Then
    Exit Function
Else
    If rsPay.RecordCount > 0 Then
        '
        rsPay.MoveFirst
        While Not rsPay.EOF
            '
            testfilehandling3 = testfilehandling3 + 1
            '
            rsPay.MoveNext
        Wend
    End If
End If
'
rsPay.Close
Set rsPay = Nothing
'
End Function

Open in new window

0
 
dqmqCommented:
You are correct, that's very inefficient code.  I don't have time to investigate in depth, but I might direct you this way.

If it is an .adp file, then it will be much more efficient to do the all the processing on the backend.  

Whether it's an .adp file or otherwise, you can gain efficiency by using set operations instead of record-at-a-time operations.  Said another way, use SQL where possible instead of recordsets.   It's difficult to advise much further about that without knowing more about what "do something here" means inside your loop.

0
 
mlcktmguyAuthor Commented:
Thanks for your response.  'Do something here' is different in different calls.

 The first example of' 'do someting here' in the code window below is to accumulate totals for all of the related records.  

The second examle is to return several fields related to a specific Fee ID.

Hopefully this is enough information to provide suggestions for imporvement.
Example 1: --------------------------------------------------------
Public Sub getTaxRecYearlyPayments(passedTaxRecID As Long, _
                             returnYearlyFacePaid As Double, _
                             returnYearlyMuniSrvcsPaid As Double, _
                             returnYearlyInterestPaid As Double, _
                             returnYearlyPenaltyPaid As Double, _
                             passedPosted_UnPosted_Both As Long)
'
' Accumulate Main Payment Recs, except for Fees.  Feees must be done while the unpaid fee records are being processed
'
Dim wkFaceAmt As Double
Dim wkMunicipalSrvcFeesAmt As Double
Dim wkPenaltyAmt As Double
Dim wkInterestAmt As Double
 
wkFaceAmt = 0
wkMunicipalSrvcFeesAmt = 0
wkPenaltyAmt = 0
wkInterestAmt = 0
'
selectString = "Select *  From qryPayments_Year_Sub Where [TaxRecID] = " & passedTaxRecID
'
If passedPosted_UnPosted_Both = cPostedAndUnposted Then
Else
    selectString = selectString & " And [PostedStatusID] = " & passedPosted_UnPosted_Both
End If
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
rsIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsIn.EOF Then
    Exit Sub
Else
    If rsIn.RecordCount > 0 Then
        '
        rsIn.MoveFirst
        While Not rsIn.EOF
            '
            wkFaceAmt = wkFaceAmt + Nz(rsIn!Face, 0)
            wkMunicipalSrvcFeesAmt = wkMunicipalSrvcFeesAmt + Nz(rsIn!MunicipalSrvcFees, 0)
            wkPenaltyAmt = wkPenaltyAmt + Nz(rsIn!Penalty, 0)
            wkInterestAmt = wkInterestAmt + Nz(rsIn!Interest, 0)
            '
            rsIn.MoveNext
        Wend
    End If
End If
'
rsIn.Close
Set rsIn = Nothing
'
returnYearlyFacePaid = wkFaceAmt
returnYearlyMuniSrvcsPaid = wkMunicipalSrvcFeesAmt
returnYearlyInterestPaid = wkInterestAmt
returnYearlyPenaltyPaid = wkPenaltyAmt
'
End Sub

'Example2 -----------------------------------------------------

Public Sub getAllFeeInfo(passedFeeID As Long, _
                         returnShortFeeDesc As String, _
                         returnLongFeeDesc As String, _
                         returnHourlyFee As Boolean, _
                         returnHrlyRateOrFixedAmt As Double, _
                         returnPaymentPriority As Long, _
                         returnTriggeringEventID As Long)
'
 
selectString = "Select *  From tblYearFees Where [ID] = " & passedFeeID
'
returnShortFeeDesc = ""
returnLongFeeDesc = ""
returnHourlyFee = False
returnHrlyRateOrFixedAmt = 0
returnPaymentPriority = 9999
returnTriggeringEventID = 0
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
rsIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsIn.EOF Then
    Exit Sub
Else
    If rsIn.RecordCount > 0 Then
        '
        rsIn.MoveFirst
            returnShortFeeDesc = Nz(rsIn!ShortFeeDesc, "")
            returnLongFeeDesc = Nz(rsIn!LongFeeDesc, "")
            returnHourlyFee = Nz(rsIn!HourlyFee, cNo)
            returnHrlyRateOrFixedAmt = Nz(rsIn!HrlyRateOrFixedAmt, 0)
            returnPaymentPriority = Nz(rsIn!PaymentPriority, 0)
            returnTriggeringEventID = Nz(rsIn!TriggeringEventID, 0)
    End If
End If
'
rsIn.Close
Set rsIn = Nothing
'
 
End Sub

Open in new window

0
 
dqmqCommented:
Accumulating totals:
In example 1, allow the database accumulate the totals. Something like this:

Example 1: --------------------------------------------------------
Public Sub getTaxRecYearlyPayments(passedTaxRecID As Long, _
                             returnYearlyFacePaid As Double, _
                             returnYearlyMuniSrvcsPaid As Double, _
                             returnYearlyInterestPaid As Double, _
                             returnYearlyPenaltyPaid As Double, _
                             passedPosted_UnPosted_Both As Long)
'
' Accumulate Main Payment Recs, except for Fees.  Feees must be done while the unpaid fee records are being processed
'
Dim wkFaceAmt As Double
Dim wkMunicipalSrvcFeesAmt As Double
Dim wkPenaltyAmt As Double
Dim wkInterestAmt As Double
 
wkFaceAmt = 0
wkMunicipalSrvcFeesAmt = 0
wkPenaltyAmt = 0
wkInterestAmt = 0
'
selectString = "Select  sum(rsIn!Face) FaceAmt, sum(rsIn!MunicipalSrvcFees) MunicipalSrvcFeesAmt, sum( Penalty)  PenaltyAmt, sum(Interest) InterestAmt
From qryPayments_Year_Sub Where [TaxRecID] = " & passedTaxRecID
'
If passedPosted_UnPosted_Both = cPostedAndUnposted Then
Else
    selectString = selectString & " And [PostedStatusID] = " & passedPosted_UnPosted_Both
End If
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
rsIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If not rsIn.BOF and not rsIn.EOF
            rsIn.MoveFirst
            wkFaceAmt = rsIn!FaceAmt
            wkMunicipalSrvcFeesAmt = rsIn!MunicipalSrvcFeesAmt
            wkPenaltyAmt = rsIn!PenaltyAmt
            wkInterestAmt = rsIn!InterestAmt
End If
'
rsIn.Close
Set rsIn = Nothing
'
returnYearlyFacePaid = wkFaceAmt
returnYearlyMuniSrvcsPaid = wkMunicipalSrvcFeesAmt
returnYearlyInterestPaid = wkInterestAmt
returnYearlyPenaltyPaid = wkPenaltyAmt
'
End Sub
0
 
dqmqCommented:
Wait... the code I just provided for Example 1 pushes some processing to the database rather than doing it in the front end.  That's well-and-good, but looking further we may even do better.

That code is called repeatedly inside a loop.  Your code doesn't reveal what the outer loop does with the results, but quite possibly, the sql for the outer loop and the sql inside the nested function can be combined such that you only need to issue a single database call and then iterate over the results.

For example, we started with this:

 open recordset "select * from tbl"
 while rows remaining
      open recordset "select * from tbl where id="
      while rows remaining
            accumulate totals
            next record for id
       end while
       do something with totals
       close recordset
       next id
 end while
 close recordset

Then, in previous frame improved it to something like this:

 open recordset "select * from tbl"
 while rows remaining
      open recordset "select sum(amt) from tbl where id="
      do something with totals
      close recordset
      next id
 end while
 close recordset
 
But, we are still opening a recordset for each ID.  Maybe, maybe we could further improve like this:

 open recordset "select sum(amt) from tbl group by ID"
 while rows remaining
      do something with totals
      next id
 end while
 close recordset


In this case, we've completely eliminated the function that accumulates by ID, and we've reduced the SQL requests dramatically.  I think you will notice a serious improvement in performance.  

Give it a try











0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now