Hej
Vi har precis uppgraderat vårat projekt från VB5 där vi kopplade
oss till databasen med hjälp av DAO och ODBC.
Trögt tyckte vi och uppgraderade till VB6 och ADO och OLEDB.
Problemet som uppstår nu är att vissa rutiner har blivit fruktansvärt
långsamma efter att man kompilerat.

Ett exempel:
En rutin som loopar igenom ett antal hundra poster tar ca 35 sek
okompilerat i designläge och ca 3 min kompilerat. Varför ???

Vi får alltså bättre prestanda med den gamla VB5-lösningen.

Vi har MDAC 2.8 installerat.

Någon som vet??
Tacksam för svar.

Hur ser eran kod ut?

Private Sub PrintList(Destination As PrintDestTyp)
Dim SS As New ADODB.Recordset
Dim SS1 As New ADODB.Recordset
Dim SS2 As New ADODB.Recordset
Dim SS3 As New ADODB.Recordset

Dim Okay As Boolean
Dim Antal As Integer
Dim Max As Integer

Dim ListNr As Integer
Dim j As Integer
Dim i As Integer, AntEx As Integer, LLErr As Integer
Dim Count As Long, XAnt As Long, GrAnt As Long
Dim Belopp As Currency, GrDiff As Currency
Dim CopyCount As Integer, FakturaTyp As Integer
Dim AnvID As String, AnvNamn As String, TmpString As String, RubrikText As String, ArtikelKod As String
'
Dim KravDatum As String
Dim PaketAvresaKoll As String, GruppKoll As String, BetDatum As String
Dim XDef As String
'
On Error GoTo ExitPrint
'
XDef = ListView90.SelectedItem.Text
'
'--- Definieringar av Variabler samt tabellfält -----------------------------
'
'Raderar tidigare variabler
LlDefineVariableStart (hLlJob)
LlDefineFieldStart (hLlJob)
'
'
'Definiera Rubriker

nDummy = LlDefineVariableExt(hLlJob, "BlankettRubrik", ListNamn, LL_TEXT, "")
If FC(0).Value = 0 Or Val(FC(0).KeyValue) = 9999 Then
FöretagsNamn = LoadResString(17662)
ElseIf Val(FC(0).KeyValue) = 0 Then
FöretagsNamn = HQ_FöretagsNamn
Else
SQLStr = "SELECT * FROM Filialer Where Filialkod=" & Val(FC(0).KeyValue)
SQLStr = SQLStr & " ORDER BY FilialKod"
SS.Open SQLStr, DB1, adOpenForwardOnly, adLockReadOnly
If Not SS.EOF Then
FöretagsNamn = TTrimNull(SS!FöretagsNamn)
End If
SS.Close
End If
nDummy = LlDefineVariableExt(hLlJob, "FöretagsNamn", FöretagsNamn, LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "Användare", CurrentUserID, LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UtskriftsDatum", Format(Now, "YYYY-MM-DD") & " " & Format(Now, "hh.mm"), LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "Logo", "", LL_DRAWING, "")
nDummy = LlDefineVariableExt(hLlJob, "KravDatum", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalFrån1", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalTill1", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalFrån2", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalTill2", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalRub1", "", LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalRub2", "", LL_TEXT, "")

'
nDummy = LlDefineFieldExt(hLlJob, "PaketID", "", LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "ResvägsID", "", LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "PaketBenämning", "", LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "AvreseDatum", "", LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "MaxBokade", "", LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "AntBokade", "", LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "BokBelopp", "", LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "Inbetalt", "", LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "Differens", "", LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "BokBelExkl", "", LL_NUMERIC, "")

'---- Selektering enligt urvalen ----
SQLStr = "SELECT * FROM BokHuvud WHERE BokHuvud.PaketID='" & FT(2).Value & "'"
SQLStr = SQLStr & " ORDER BY PaketID"
SS.Open SQLStr, DB2, adOpenForwardOnly, adLockReadOnly
'
'Definierar fält-variabler
ModPrint_DefineFields SS, SET_FIELD_DEFINITION
SS.Close

nDummy = LlDefineFieldExt(hLlJob, "Condition", "", LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "Condition2", "", LL_TEXT, "")

'---- Initierar utskrift ----
LLErr = SYS_InitPrinter(XDef, Destination, CurrentPrint.RapportPath, CurrentPrint.RapportNamn, Check1.Value, ListNamn)
If LLErr Then GoTo ExitPrint
'
KravDatum = FT(1).Value
nDummy = LlDefineVariableExt(hLlJob, "KravDatum", KravDatum, LL_TEXT, "")
SökFrån = FT(2).Value
SökTill = FT(3).Value
SökFrånAvresa = FT(7).Value
SökTillAvresa = FT(0).Value
nDummy = LlDefineVariableExt(hLlJob, "UrvalRub1", LoadResString(17656), LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalRub2", LoadResString(17657), LL_TEXT, "")

nDummy = LlDefineVariableExt(hLlJob, "UrvalFrån1", SökFrån, LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalTill1", SökTill, LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalFrån2", SökFrånAvresa, LL_TEXT, "")
nDummy = LlDefineVariableExt(hLlJob, "UrvalTill2", SökTillAvresa, LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "@User01", KravDatum, LL_TEXT, "")

If SökFrån <> "" Then SökFrån = "'" & SökFrån & "'"
If SökTill <> "" Then SökTill = "'" & SökTill & Chr(246) & Chr(246) & "'"
If SökFrånAvresa <> "" Then SökFrånAvresa = "'" & SökFrånAvresa & "'"
If SökTillAvresa <> "" Then SökTillAvresa = "'" & SökTillAvresa & Chr(246) & Chr(246) & "'"
AddWhere = True
SQLStr = "SELECT COUNT(*) AS Antal FROM PaketMall"
If SökFrån <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " PaketID >= " & SökFrån
End If
If SökTill <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " PaketID <= " & SökTill
End If
'SYS_AddSQLQuestion
'SQLStr = SQLStr & " Restyp=3"
SS.Open SQLStr, DB2, adOpenForwardOnly, adLockReadOnly
If Not SS.EOF Then
XAnt = SS!Antal
End If
SS.Close
'
PaketAvresaKoll = ""
AddWhere = True
SQLStr = "SELECT PaketID, Benämning FROM PaketMall"
If SökFrån <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " PaketID >= " & SökFrån
End If
If SökTill <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " PaketID <= " & SökTill
End If
'SYS_AddSQLQuestion
'SQLStr = SQLStr & " Restyp=3"
SQLStr = SQLStr & " ORDER BY PaketID"
SS.Open SQLStr, DB2, adOpenForwardOnly, adLockReadOnly
'
Count = 0 'Räknare av antal poster i Recordset för ProgressBar
ProgressBar1.Value = 0
ProgressBar1.Min = 0
ProgressBar1.Max = XAnt
If XAnt > 0 Then
'---- Sätter min/max-värde på ProgressBar ----
'
'Byt ut RecordCount mot SELECT COUNT genomgående i listor!!!
'
'
'---- Skapar första sidan ----
nDummy = LlDefineFieldExt(hLlJob, "Condition", "A", LL_TEXT, "")
GruppKoll = ""
LLErr = LlPrint(hLlJob)
If LLErr Then GoTo ExitPrint 'Fångar ev. L&L fel
End If
CancelPrint = False
While Not CancelPrint And Not SS.EOF
GrDiff = 0
AddWhere = False
SQLStr = "SELECT * FROM BokHuvud WHERE BokHuvud.PaketID='" & SS!PaketID & "'"
If SökFrånAvresa <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " Avresa >= " & SökFrånAvresa
End If
If SökTillAvresa <> "" Then
SYS_AddSQLQuestion
SQLStr = SQLStr & " Avresa <= " & SökTillAvresa
End If
SQLStr = SQLStr & " AND (BokHuvud.BevDatum = '' OR BokHuvud.BevDatum Is Null)"
SYS_AddSQLQuestion
SQLStr = SQLStr & " (BokStatus < 7 OR BokStatus>=9)" 'Ej registrerade som inte skrivs ut
SQLStr = SQLStr & " ORDER BY PaketID, Avresa, BokNr"
SS2.Open SQLStr, DB2, adOpenForwardOnly, adLockReadOnly
While Not CancelPrint And Not SS2.EOF
'
'MsgBox "Boknr: " & VTrimNull(SS2!Boknr)
Okay = False
If Val(FC(0).KeyValue) = 9999 Or FC(0).Value = 0 Then
Okay = True
Else
SQLStr = "SELECT PostgiroKod FROM Användare WHERE AnvändarID='" & TTrimNull(SS2!FID) & "'"
SS3.Open SQLStr, DB1, adOpenForwardOnly, adLockReadOnly
If Not SS3.EOF Then
If Val(FC(0).KeyValue) = VTrimNull(SS3!PostgiroKod) Then
Okay = True
End If
End If
SS3.Close
End If
'
If Okay Then
ModPrint_DefineFields SS2, SET_FIELD_VALUE
If PaketAvresaKoll <> Trim(TTrimNull(SS!PaketID)) & Trim(TTrimNull(SS2!Avresa)) Then
GrDiff = 0
End If
PaketAvresaKoll = Trim(TTrimNull(SS!PaketID)) & Trim(TTrimNull(SS2!Avresa))
Belopp = 0: InbBelopp = 0
If KravDatum > TTrimNull(SS2!AnmDatum) And Trim(TTrimNull(SS2!AnmDatum)) <> "" And VTrimNull(SS2!BokStatus) < 8 Then
Belopp = Belopp + VTrimNull(SS2!AnmAvg)
BetDatum = SS2!AnmDatum
End If
If KravDatum <= TTrimNull(SS2!SluDatum) And Trim(TTrimNull(SS2!SluDatum)) <> "" Then
'
ElseIf KravDatum > TTrimNull(SS2!SluDatum) And Trim(TTrimNull(SS2!SluDatum)) <> "" Then
If VTrimNull(SS2!BokStatus) = 9 Then
Belopp = Belopp + VTrimNull(SS2!Netto)
Else
If TTrimNull(SS2!AgentID) = TTrimNull(SS2!KundID) And Trim(TTrimNull(SS2!AgentID)) <> "" Then
Belopp = Belopp + VTrimNull(SS2!Netto)
Else
Belopp = Belopp + VTrimNull(SS2!SluAvg)
End If
End If
BetDatum = TTrimNull(SS2!SluDatum)
End If
InbBelopp = ModArr_Inbetalt(SS2!Boknr)
If (Belopp - InbBelopp) > 0 Then
nDummy = LlDefineFieldExt(hLlJob, "PaketID", TTrimNull(SS!PaketID), LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "PaketBenämning", TTrimNull(SS!Benämning), LL_TEXT, "")
PaketAvresaKoll = Trim(TTrimNull(SS!PaketID)) & Trim(TTrimNull(SS2!Avresa))
nDummy = LlDefineFieldExt(hLlJob, "AvreseDatum", TTrimNull(SS2!Avresa), LL_TEXT, "")
nDummy = LlDefineFieldExt(hLlJob, "BokBelopp", Belopp, LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "Inbetalt", InbBelopp, LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "Differens", Belopp - InbBelopp, LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "@User02", BetDatum, LL_TEXT, "")
GrDiff = GrDiff + (Belopp - InbBelopp)
nDummy = LlDefineFieldExt(hLlJob, "@Sum06", DateDiff("d", BetDatum, KravDatum), LL_NUMERIC, "")
nDummy = LlDefineFieldExt(hLlJob, "@Sum05", GrDiff, LL_NUMERIC, "")
If VTrimNull(SS2!BokStatus) = 9 Then
nDummy = LlDefineFieldExt(hLlJob, "@User10", "Avb", LL_TEXT, "")
ElseIf VTrimNull(SS2!BokStatus) = 8 Then
nDummy = LlDefineFieldExt(hLlJob, "@User10", "MkR", LL_TEXT, "")
Else
nDummy = LlDefineFieldExt(hLlJob, "@User10", "", LL_TEXT, "")
End If
nDummy = LlDefineFieldExt(hLlJob, "Condition2", PaketAvresaKoll, LL_TEXT, "")
If LlPrintFields(hLlJob) = LL_WRN_REPEAT_DATA Then 'Om Tabellen ej räcker till, upprepa senaste post...
LLErr = LlPrint(hLlJob) '... på nästa sida
If LLErr Then GoTo ExitPrint
LLErr = LlPrintFields(hLlJob) 'Skriv igen
If LLErr Then GoTo ExitPrint
End If
ProgressBar1.Value = Count
If Count Mod 5 = 1 Then DoEvents
End If
End If
SS2.MoveNext
Wend
SS2.Close
Count = Count + 1
ProgressBar1.Value = Count
SS.MoveNext
Wend
SS.Close
nDummy = LlPrintEnd(hLlJob, 0)
'
'nDummy = LlDefineFieldExt(hLlJob, "Condition2", PaketAvresaKoll, LL_TEXT, "")
If Destination = DEST_PRINTER Then
'Filen är på väg till skrivaren
ElseIf Destination = DEST_EMAIL Then
'E-post
'Sänd fil: Lägg in LL/PDF/RTF/HTML-filen i en collection
ColFiler.AddNew PreviewPath & "\" & CurrentPrint.RapportNamn & "." & XDef
ElseIf XDef = "LL" Then
'Förhandsgranskning: Visa LL-filen på skärmen
LLErr = LlPreviewDisplay(hLlJob, CurrentPrint.RapportNamn, PreviewPath, hWnd)
If LLErr Then GoTo ExitPrint
End If
Exit Sub

ExitPrint:
'Kontrollerar utskriftsfel
If LLErr <> 0 Then
ModPrint_HasError LLErr
LlPrintAbort (hLlJob)
Else
MsgBox Error(Err)
End If
nDummy = LlPrintEnd(hLlJob, 0)
'SS.Close
End Sub

Det finns ju olika kompileringsalternativ tror att Ni kompilerat i P Code

Dat skall vara Optimize for Fast Code och under Avancerat kan Ni säkert
bocka för alla alternativ. VB 6 tillverka snabb kod det har jag aldrig klagat på.

När du väljer Make Exe så välj Option och ställ in Fast Code.

Vi har alltid kompilerat för "Fast Code".
Nu har vi testat på skoj att kompilera i P-code.

Och??

Den var snabbare.

!!!!????
HUUUUH?

Sen är det väl känt att ADO är ett segt djä.. skit.
< MDAC 2.8 installerat.

MDAC är bara intressant om Ni kör mot annat än Access.

3 min är helt sannslöst borde gå på några sekunder .Ni har ett stort fel i koden
hamnar i nån form av loop som inte gör nått vettigt.

Vb kompilerar till helt godkänd snabb kod,det måste vara nått annat.

Om Ni orkar så gör det hela i DAO 3.6 med Jet 4.0 det är det optimala mot Access.

Bör fungera mycket bra i ADO, sök felet i hur databsen är uppbyggd. Kan vara så att ni måste sekvensläsa hela tiden eller att ni läser på del av nyckel som gör att databsen får arbeta idiotiskt mycket.

Grunden för allt med relationsdatabser är att den är rätt normaliserad och anpassad efter tänkt funktion.

Har kikat lite på koden du lagt in.

Rysare.

Börja med att strukturera programmet innan ni kodar.

Finns några loopar som verkar vara vara knepiga.
Läs gärna någon bok om JSP (strukturerad programering)
samt om design av databser och dess normalisering.

Vi använder oss av en SQL-server 2000

Tycker också att koden är en rysare. Tycker att ämnet är intressant
Oki på SQL server , då är MDAC relevant.

Jag vill att du kompilerar under Fast Code och under Advanced bockar för alla alternativ.
Intressant att höra om det funkar och vad du får för tid då.

Det är en kollega som jag försöker hjälpa och det verkar sluttestat för idag.

Tack för alla dagens tips.
Fortsättning följer...

Nu är vårat problem löst.
Problemet hade inget med VB eller ADO att göra
utan felet ligger i våran rapportgenerator (COMBITS, List & Labels 9).
Det är tydligen något knas med någon av deras DLL:er.

Så var det med det.

Tack för all hjälp ändå.