[VB & MySQL] Event fetchProgress wordt niet aangeroepen

[jctprod]

Hallo allemaal,

Ik ben bezig met een VB applicatie die met grote hoeveelheden data om moet gaan. Om de gebruiker het idee te geven dat er nog iets gebeurt wil ik een progressbar opnemen die gekoppeld is aan de status van de query die op dat moment wordt uitgevoerd. Ik heb wat op internet gezocht naar de mogelijkheden en dit valt goed te doen met het ADO recordset event 'fetchProgress'. Dit event wordt tijdens het uitvoeren van de query om de x aantal records ge-raised.

Op de website van Microsoft is een voorbeeld omschreven die werkt. Kijk hiervoor op http://support.microsoft....aspx?scid=kb;en-us;262311. Ik heb dit voorbeeld in een apart project gezet en de connectiestring en query aangepast naar mijn situatie. Zelf heb ik nog even progressbar ingebouwd en in dat project werkt het allemaal goed!

Toen ik het echter in het al bestaande project wilde implementeren weigerde deze methode te werken... Alles werkt wel gewoon, maar er wordt op geen enkele manier de sub 'rs_fetchProgress(...)' aangeroepen!

Wie kan mij helpen?

Voor alle duidelijkheid hieronder de belangrijkste onderdelen van de code uit het project...

code:

Option Explicit

Dim mc As ADODB.Connection
Dim WithEvents rs As ADODB.Recordset
Private colAdjustments As New Collection

Private Sub synchronizeRelations()
On Error GoTo mcError

    Dim intAantalRecords, intPosition As Integer
   
    Set mc = New ADODB.Connection
    Set rs = New ADODB.Recordset

    'Connect to the MySQL database
    lblStatus = "Bezig met het verbinden met de MySQL database..."
    lblStatus.Refresh
    mc.ConnectionString = "DRIVER={" & colAdjustments("DriverName") & "};" _
            & "SERVER=" & colAdjustments("Server") & ";" _
            & "DATABASE=" & colAdjustments("Database") & ";" _
            & "UID=" & colAdjustments("User") & ";" _
            & "PWD=" & colAdjustments("Password") & ";" _
            & "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 16384
    mc.Open

    rs.Open "SELECT COUNT(id) FROM tblrelatie", mc 'Aantal te verwachten records bepalen ivm progressbar
     pgb.Max = rs.Fields(0).Value
    rs.Close

    'Execute the query and receive the results in the recordset
    lblStatus = "Bezig met het ophalen van de relaties..."
    lblStatus.Refresh
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Properties("Initial Fetch Size") = 2
    rs.Properties("Background Fetch Size") = 4
    rs.Open "SELECT * FROM tblrelatie WHERE fldSyncStatus='u' OR fldSyncStatus='a'", mc, , , adAsyncFetch

    intAantalRecords = rs.RecordCount
    pgb.Max = intAantalRecords
    pgb.Value = 0

    If rs.RecordCount <> 0 Then rs.MoveFirst
    Do Until rs.EOF

        intPosition = rs.AbsolutePosition
        pgb.Value = intPosition
        pgb.Refresh
        lblStatus = "Bezig met het sychroniseren van relatie " & intPosition & " van de " & intAantalRecords & "..."
        lblStatus.Refresh
  
        If rs.Fields("fldRelatieSoort") = 1 Then 'Het gaat om een klant
          'Code voor een klant
        Else 'Het gaat om een leverancier
          'Code voor een leverancier
        End If
        
        rs.MoveNext
    Loop
    
    lblStatus = "Het synchroniseren van de relaties is voltooid!"
    lblStatus.Refresh

    rs.Close
    Set rs = Nothing

    mc.Close
    Set mc = Nothing

    End

    Exit Sub

mcError:
    HandleError

End Sub
Private Sub rs_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

    Debug.Print "Fetch: " & Progress & " Max: " & MaxProgress
    pgb.Value = Progress
    pgb.Refresh

End Sub
Private Sub rs_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

    If adStatus <> adStatusOK Then
        Debug.Print "Failed"
        Debug.Print "Error: " & pError.Number & " - " & pError.Description
    Else
        Debug.Print "Done"
    End If

End Sub

Voor alle duidelijkheid: in de collectie colAdjustments staan alle instellingen mbt de database connectie

[jctprod]

Beste mensen,

Na eigenlijk de hele dag hiermee bezig te zijn geweest, kan ik inmiddels zeggen dat dit probleem is opgelost!

Iedereen bedankt voor het lezen en sorry voor het aanmaken van een hele nieuwe topic voor een probleem dat uiteindelijk toch is opgelost voor een eerste reactie is gegeven!

De uiteindelijke oplossing was het verwijderen van de code die iets met de records doet... Door de flag 'adAsyncFetch' wordt het de query door een ander proces uitgevoerd en gaat het programma gewoon verder met uitvoeren van de volgende regels... Omdat ik gelijk weer iets met die recordset ging doen, die ondertussen nog werd gevuld, heeft VB waarschijnlijk uit veiligheid het in een ander proces uitvoeren van de query geannuleerd. Oplossing was dus het overplaatsen van de code voor het verwerken van de recordset naar een eigen sub die pas wordt aangeroepen als de recordset het event fetchComplete afgeeft... Op die manier wordt voorkomen dat je met een halve recordset aan de haal gaat!

Doe er je voordeel mee!