Loop looses momentum 1

[hermanlaksko]

I have a function that loops thru a recordset, however as it moves thru the records it gradually becomes slower and slower.
I have tryed to close a recordset that I use for a FindFirst along the way and also closing the DB (CurrentDatabase) all to no evail.

Below I deliver 2 dates a start and an enddate and for every 7 days it makes the loop and the inner loop, that seems to run fast enough, is run as many thimes as 40.000 where the outer loop (first loop) is only called apx. 60-80 times and, it seeme to me, that it is this outer loop that is the slow one - but that could be the way I see it.

Code example:
Do While DateValue(RDate) <= DateValue(ToDate)
Tal = Tal + 1
SQL = "INSERT INTO TempProject ( KeepYN, Ind, Lev, Change, RID, FMT_ID, Nr, Sansynelighed, Konsekvens, [Index], RType, NedlagtYN, Narhed, DumpID ) " _
& " SELECT False, 0, " & Sorter & ", #" & DateValue(RDato) & "# As RChange, RID, FMT_ID, Nr, Sansynelighed, Konsekvens, Index, RType, False, Narhed, DumpID FROM Project" _
& " WHERE FMT_ID='" & MNr & "' AND RType=" & RType & " AND DumpID Is Null AND Dato<=" & CDbl(RDato)
DB.Execute (SQL)
' = 1 til proj uden ,
DB.Execute ("Update TempProject Set Narhed=1 Where Narhed Is Null")
'Udregn Index
If Not LastRun Then
Set Rx = DB.OpenRecordset("SELECT No, Change, Lev, ([KarakterK]*[Sansynelighed])*[indeks] AS Prod FROM (Project LEFT JOIN Konsekvens ON Project.Konsekvens = Konsekvens.KID) LEFT JOIN ON Project.Narhed = .NID" _
& " WHERE FMT_ID='" & MNr & "' AND RType=" & RType & " AND Change<=" & CDbl(RDato) & " ORDER BY No, Change DESC", 4)
End If
SQL = "SELECT IND, Lev As RNavn, Nr, Change, RID, NedlagtYN, ([KarakterK]*[Sansynelighed])* [indeks] AS Prod" _
& " FROM (TempProject LEFT JOIN Konsekvens ON TempProject.Konsekvens = Konsekvens.KID) LEFT JOIN ON TempProject.Narhed = .NID" _
& " ORDER BY Nr, RID, Lev"
Set Re = DB.OpenRecordset(SQL, 2, 512)
If Re.RecordCount > 0 Then
Ant = 0
Do While Not Re.EOF
NedYN = False
Rs.FindFirst "RID=" & Re!RID
If Not Rs.NoMatch Then
Dato = CDate(Left(Rs!LogDato, 10))
If Dato <= RDato Then NedYN = True
End If
If Not LastRun Then
Rx.FindFirst "Lev = '" & Re!RNavn & "' AND No='" & MNr & "-" & Re!Nr & "'"
Re.Edit
If Not Rx.NoMatch Then Re!Ind = Format(Nz(Rx!Prod, 0), "Standard") Else Re!Ind = Format(Nz(Re!Prod, 0), "Standard")
Else
Re.Edit
Re!Ind = Format(Nz(Re!Prod, 0), "Standard")
End If
If NedYN Then
Re!Ind = 0
Re!NedlagtYN = True
End If
Re.Update
Re.MoveNext
Ant = Ant + 1
Application.SysCmd acSysCmdSetStatus, Txt(0) & " " & RDato & " ( " & Ant & " )"
Loop
End If
SQL = "INSERT INTO TempLog ( TRID, Idx, RNavn, Nedlagt, RChange )" _
& " SELECT " & Tal & ", Sum(Ind) As Idx, Lev, NedlagtYN, " & CDbl(RDato) & " FROM TempProject " _
& " WHERE DumpID Is Null GROUP BY KeepYN, Lev, NedlagtYN" _
& " ORDER BY Lev"
DB.Execute (SQL)
RDat = RDate + 7
DB.Execute ("Delete * From TempProject")
Application.SysCmd acSysCmdSetStatus, Txt(0) & " " & RDate
DoEvents
Loop

The first 20-30 loops are fine but then it slows down.
Can anyone give me a solution or just a hint - Thank you so much.

 

[vbajock]

Are the tables actually in the mdb you are running your code from? Try splitting the mdb if that is the case.

 

[genomon]

Try adding this after you open the recordset:

YourRSName.LockEdits = False
DAO.DBEngine.SetOption dbMaxLocksPerFile, 30000

You can tweak the value for maxlocks to find an optimum value.


Beir bua agus beannacht!

 

[hermanlaksko]

vbajock - Thanks for your suggestion, however this move did not change anything.

genomon - Thank you for this interesting suggestion, it does give the loop a bit more momentum - not as much as I would have liked, but that is just the way I am
I increased the number to 200.000 and got some increase but after this number, nothing, but perhaps 200.000 is max.
However your suggestion go me reading, so perhaps this will lead to extra speed, if so, I'll post here.

Any other suggestions are welcome, Thank you all.

Herman
Say no to macros