Comprendre les Recordset ADO

Dans l'exemple suivant, je vais ouvrir trois fois le même recordset avec trois méthodes différentes. Nous discuterons ensuite des différences.

Private Sub Form_Load()
Dim Cnn1 As ADODB.Connection, Cmd1 As ADODB.Command, MonRs As ADODB.Recordset

Set Cnn1 = New ADODB.Connection
With Cnn1
    .Provider = "Microsoft.Jet.OLEDB.4.0;"
    .ConnectionTimeout = 30
    .Mode = adModeShareExclusive
    .Open "Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
End With
'par Connection.Execute
Set MonRs = Cnn1.Execute("SELECT * From Authors", , adCmdText)
MonRs.Close
'par command.execute
Set Cmd1 = New ADODB.Command
With Cmd1
    .ActiveConnection = Cnn1
    .CommandType = adCmdText
    .CommandText = "SELECT * From Authors"
End With
Set MonRs = Cmd1.Execute
MonRs.Close
'par recordset.open
Set MonRs = New ADODB.Recordset
MonRs.Open "SELECT * From Authors", Cnn1, , , adCmdText

End Sub

Il n'y a pas de différence entre créer le recordset par la méthode Open ou par Command.Execute, dans les deux cas, l'objet Recordset à une référence à ActiveCommand et ActiveConnection. Par contre, le recordset créé par Connection.Execute n'a pas de référence à ActiveCommand. Cela vient du fait que la méthode Execute de l'objet Connection utilise une commande « volatile » qui ne crée pas d'objet Command.

Dans cet exemple je n'ai précisé aucun paramètre, j'ai donc trois fois un curseur serveur, en avant seulement et en lecture seule.

Nous allons voir maintenant l'ouverture d'un recordset configuré.

Private Sub Form_Load()
Dim Cnn1 As ADODB.Connection, Cmd1 As ADODB.Command, MonRs As ADODB.Recordset

Set Cnn1 = New ADODB.Connection
With Cnn1
    .Provider = "Microsoft.Jet.OLEDB.4.0;"
    .ConnectionTimeout = 30
    .IsolationLevel = adXactIsolated
    .Mode = adModeReadWrite
    .Open "Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
End With
'Set Cmd1 = New ADODB.Command
'With Cmd1
'    .CommandType = adCmdText
'    .CommandText = "SELECT * From Authors"
'End With
Set MonRs = New ADODB.Recordset
With MonRs
    .CursorLocation = adUseClient
    .LockType = adLockBatchOptimistic
    .CursorType = adOpenStatic
    .CacheSize = 30
    .Source = "SELECT * From Authors"
    Set .ActiveConnection = Cnn1
'    Set .ActiveCommand = Cmd1
    .Open , , , , adCmdText
End With

End Sub

Le code que je vous ai mis en commentaire déclenchera une erreur s'il est utilisé. En effet on ne peut pas affecter d'objet Command à la propriété ActiveCommand. Si je veux passer l'objet Command, j'utiliserai Recordset.Open avec le nom de l'objet Command comme source de mon Recordset.

En résumé donc, aucune méthode n'est équivalente. On utilise donc le choix selon les critères suivants :

Connection.Execute -> Crée des requêtes volatiles (non réutilisable), en lecture seule

Command.Execute -> Crée des jeux d'enregistrement toujours en lecture seule.

Recordset.Open -> Permet l'accès aux curseurs disponibles. C'est la seule méthode à utiliser pour agir sur la source de données par l'intermédiaire d'un recordset.

Voyons enfin le cas de la création d'un jeu d'enregistrements par l'intermédiaire d'une requête paramétrée.

Dim Cnn1 As ADODB.Connection, MonRs As ADODB.Recordset, MaCommand As ADODB.Command
Dim Param1 As ADODB.Parameter

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseClient
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\biblio.mdb ;User Id=Admin; Password="
Set MaCommand = New ADODB.Command
With MaCommand
    .ActiveConnection = Cnn1
    .CommandType = adCmdText
    .CommandText = "PARAMETERS Annee Long;SELECT Authors.Au_ID, Authors.Author, Authors.[Year Born] FROM Authors WHERE [Year Born]=Annee"
    Set Param1 = .CreateParameter("Annee", adInteger, adParamInput, , 1941)
    .Parameters.Append Param1
End With
Set MonRs = New ADODB.Recordset
MonRs.Open MaCommand, , adOpenKeyset, adLockOptimistic
MonRs.ActiveCommand.Parameters(0).Value = 1940
MonRs.Requery

Comme nous le voyons, il n'est nécessaire de créer le paramètre qu'une fois. Après cela, on peut modifier la valeur par l'intermédiaire de la propriété ActiveCommand de l'objet Recordset. De même, nous voyons que je n'ai pas besoin de spécifier la propriété CursorLocation de mon Recordset puisqu'il va hériter de celle de la connexion.

Dans cet exemple nous allons travailler sur la navigation sans les méthodes « Move » dans un Recordset. Pour cela nous allons utiliser deux propriétés du recordset : RecordCount et AbsolutePosition. Avant la version 2.6 d'ADO il fallait impérativement utiliser un curseur côté client pour utiliser certaines de ces propriétés, et cela reste encore le cas avec certains fournisseurs (Jet 3.51 par exemple).

Dans notre cas, la seule contrainte est d'obtenir un curseur bidirectionnel puisque les curseurs en avant seulement ne valorisent pas les propriétés RecordCount et AbsolutePosition.

Globalement la position dans un recordset est soit sur un enregistrement, soit en position BOF c'est-à-dire avant le premier enregistrement ou EOF c'est-à-dire après le dernier. La valeur de AbsolutePosition va de 1 à RecordCount.

Un signet (Bookmark) sert à identifier un enregistrement de manière à pouvoir le retrouver facilement. Ne confondez pas signet et position, ils ne sont pas identiques.

Dans cet exemple nous allons faire une ProgressBar qui indique la position de l'enregistrement courant en pourcentage. (équivalent au PercentPosition DAO)

J'ajoute donc à mon projet un contrôle DataCombo qui me permettra de sélectionner un auteur dans la liste et un contrôle ProgressBar. (COMCTL32.OCX)

Option Explicit

Private WithEvents Cnn1 As ADODB.Connection
Private WithEvents MonRs As ADODB.Recordset

Private Sub Form_Load()

Set Cnn1 = New ADODB.Connection
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.Open "SELECT * From Authors", Cnn1, adOpenKeyset, adLockReadOnly, adCmdText
With DataCombo1
    Set .RowSource = MonRs
    .ListField = "Author"
    .SelText = MonRs.Fields("Author").Value
End With

End Sub

Private Sub DataCombo1_Change()

    If IsNull(DataCombo1.SelectedItem) Then Exit Sub
    MonRs.Bookmark = DataCombo1.SelectedItem
    ProgressBar1.Value = CInt((MonRs.AbsolutePosition * 100) / MonRs.RecordCount)
    
End Sub

Dans le « Load » de la feuille, je crée mon recordset. Notez que je n'ai pas précisé la position du curseur, il sera donc côté serveur. J'affecte ensuite mon recordset comme source de données du DataCombo, et je précise quel champ servira pour le remplissage de la liste. J'utilise enfin la propriété SelText du DataCombo, pour afficher le premier enregistrement.

Tout se passe donc dans l'événement Change du DataCombo. La première ligne me permet de sortir de la procédure quand aucun élément n'est sélectionné.

La deuxième ligne positionne l'enregistrement courant sur l'élément sélectionné. On utilise la propriété Bookmark du recordset car la propriété SelectedItem du DataCombo renvoie un signet sur l'élément choisi. En clair, le fait de choisir un élément dans un DataCombo ne change pas l'enregistrement courant. Par contre, comme j'affecte la valeur du signet à la propriété Bookmark du recordset, celui-ci modifie l'enregistrement courant.

Enfin je fais mon calcul en pourcentage.

Dans cet exemple nous allons faire un petit concours de vitesse qui va nous permettre de mieux considérer les raisons d'un choix entre les recordset et l'utilisation du SQL.

Le concours est simple, nous allons extraire un jeu d'enregistrements correspondant à tous les auteurs dont le nom commence par « S » et le trier, ensuite extraire les enregistrements ou le champ [année de naissance] est rempli. Pour cela je vais utiliser deux méthodes. D'un côté nous allons utiliser des clauses SQL, de l'autre uniquement des fonctionnalités de l'objet Recordset.

Pour mesurer le temps, je vais utiliser l'API GetTickCount qui renvoie le nombre de millisecondes écoulées depuis le début de la session Windows. Par différence, j'obtiendrais le temps nécessaire. Nous sommes en mode synchrone.

Je déclare donc mon API

Private Declare Function GetTickCount Lib "kernel32" () As Long

Pour rester sensiblement comparable, je n'utiliserais que des curseurs bidirectionnels en lecture seule. Dans le premier test, je ne vais travailler qu'avec des ordres SQL. Je vais donc utiliser un curseur côté serveur. Je vais utiliser un curseur à jeu de clefs (KeySet) qui est un peu plus rapide qu'un curseur statique. La connexion ne sera pas incluse dans le calcul du temps. Le code sera le suivant :

Private Sub Command1_Click()
Dim TStart As Long

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseServer
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseServer
TStart = GetTickCount
MonRs.Open "SELECT * From Authors WHERE Author LIKE 'S*' ORDER BY Author, _ 
     [Year Born] DESC", Cnn1, adOpenKeyset, adLockReadOnly, adCmdText
MsgBox "temps = " & GetTickCount - TStart
MonRs.Close
TStart = GetTickCount
MonRs.Open "SELECT * From Authors WHERE Author LIKE 'S*' AND NOT [Year Born] IS NULL ORDER BY Author, [Year Born] DESC", _ 
    Cnn1, adOpenKeyset, adLockReadOnly, adCmdText
MsgBox "temps = " & GetTickCount - TStart

End Sub

Tel que nous le voyons, je procède à deux extractions successives.

Dans mon second test, je ne vais travailler qu'avec les fonctionnalités du recordset. Je vais donc extraire l'ensemble de la table, puis travailler sur le jeu d'enregistrements. La propriété Sort demande un curseur côté client. De ce fait le curseur sera statique. Le code utilisé sera le suivant :

Private Sub Command2_Click()
Dim TStart As Long

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseClient
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseClient
TStart = GetTickCount
MonRs.Open "SELECT * From Authors", Cnn1, adOpenStatic, adLockReadOnly, adCmdText
MonRs.Filter = "Author LIKE 'S*'"
MonRs.Sort = "Author ASC, [Year Born] DESC"
MsgBox "temps = " & GetTickCount - TStart
TStart = GetTickCount
MonRs.Filter = adFilterNone
MonRs.Filter = "Author LIKE 'S*' AND [Year Born] <> NULL"
MsgBox "temps = " & GetTickCount - TStart

End Sub

Chaque programme affichera donc deux temps, le temps qu'il lui faut pour obtenir un jeu d'enregistrements trié contenant tous les auteurs dont le nom commence par « S » et temps qu'il met pour obtenir le même jeu dont le champ "année de naissance est rempli.

Les temps ne seront jamais parfaitement reproductibles, car de nombreux paramètres peuvent jouer, mais on constate que le code SQL va de 3 à 20 fois plus vite que le filtrage et le tri du recordset (premier temps). Ceci est dû au fait que le curseur client rapatrie l'ensemble des valeurs dans son cache, puis applique le filtre et trie les enregistrements. Il est à noter que le tri par la méthode sort du recordset est très pénalisant.

Par contre, pour le deuxième temps, le second code est toujours plus rapide (deux à trois fois plus). Cela vient du fait qu'il n'est plus nécessaire de ré extraire les données, celles-ci étant présente dans le cache du client ce qui permet une exécution très rapide.

Tout cela montre bien qu'il ne faut pas a priori rejeter les fonctionnalités recordset comme on le lit trop souvent. Ce qui pénalise beaucoup les curseurs client, c'est la nécessite de passer dans le cache l'ensemble des valeurs (Marshaling), mais une fois l'opération faite, le travail devient très rapide. Une fois encore, tout est question de besoin.

Il existe donc deux méthodes de recherches sur un jeu d'enregistrements, plus deux autres qui peuvent être apparentées à une recherche, les filtres.

Commençons par ses derniers. Filtrer un jeu d'enregistrements (en SQL ou par la méthode Filter) revient à faire une recherche de tous les enregistrements répondant à certains critères. Nous avons vu dans l'exemple précédent comment les utiliser, et nous verrons dans les traitements par lot d'autres exemples.

Dans cet exemple nous allons voir les deux méthodes de recherches standard d'ADO, Seek et Find.

VIII-D-1. Recherche avec Seek▲

Private Sub Command3_Click()
Dim MonRs1 As ADODB.Recordset, maprop As Property

Set Cnn1 = New ADODB.Connection
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password="
Set MonRs1 = New ADODB.Recordset
MonRs1.CursorLocation = adUseServer
MonRs1.ActiveConnection = Cnn1
MonRs1.Index = "PrimaryKey"
MonRs1.Open "Authors", Cnn1, adOpenKeyset, adLockReadOnly, adCmdTableDirect
If MonRs1.Supports(adSeek) Then
    MonRs1.Seek InputBox("Entrez le numéro de l'auteur"), adSeekFirstEQ
End If

End Sub

Recherche avec Find▲

Private Sub cmdFind_Click()

Dim AnneeCherchee As Integer

    AnneeCherchee = Val(InputBox("Entrez l'année de naissance", , 1947))
    MonRs.Find "[year born]=" & AnneeCherchee, , adSearchForward, 1
    Do While Not MonRs.EOF
        MsgBox "nom de l'auteur -->" & MonRs!Author
        MonRs.Find "[year born]=" & AnneeCherchee, 1, adSearchForward
    Loop
    
End Sub

Private Sub cmdFind_Click()

Dim AnneeCherchee As Integer, Signet As Variant

    AnneeCherchee = Val(InputBox("Entrez l'année de naissance", , 1947))
    MonRs.MoveLast
    Signet = MonRs.Bookmark
    MonRs.Find "[year born]=" & AnneeCherchee, , adSearchBackward, Signet
    Do While Not MonRs.BOF
        MsgBox "nom de l'auteur -->" & MonRs!Author
        MonRs.Find "[year born]=" & AnneeCherchee, 1, adSearchBackward
    Loop
    
End Sub

Set cnn1 = New ADODB.Connection
cnn1.CursorLocation = adUseClient
cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password="
Set MonRs1 = New ADODB.Recordset
MonRs1.ActiveConnection = cnn1
MonRs1.Open "SELECT * FROM Authors", cnn1, adOpenStatic, adLockReadOnly, adCmdText
MonRs1.Fields("Author").Properties("Optimize") = True
MonRs1.Find "Author='Boddie, John'"

Lorsqu'on crée un nouvel enregistrement, il peut être parfois intéressant de récupérer la valeur de la clef auto-incrémentée correspondante, pour pouvoir par exemple créer des enregistrements ayant cette valeur comme clef étrangère. Dans l'exemple suivant, nous allons regarder le principe.

Private Sub Command4_Click()
Dim recup As Long

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseServer
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Biblio.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
With MonRs
    .CursorLocation = adUseServer
    .Open "SELECT * From Authors", Cnn1, adOpenKeyset, adLockPessimistic, adCmdText
    .AddNew
        !Author = "Rabilloud ,J-M"
        ![year born] = 1967
    .Update
    recup = !Au_id
End With

End Sub

Dans ce cas il n'y à rien de particulier à faire puisque le curseur est côté serveur. Notons toutefois que le curseur doit être de type « KeySet » pour que cela fonctionne.

Avec un curseur côté client, nous avons vu qu'il faut utiliser la propriété dynamique donc ajouter dans le code :

MonRs.Properties("Update Resync") = adResyncAutoIncrement

Ces contrôles aussi contiennent leurs lots de pièges divers et variés. Nous allons regarder deux exemples pour parcourir certains de ces problèmes.

VIII-F-1. Le contrôle ADO (ADODC)▲

With Adodc1
    .RecordSource = "SELECT * FROM Authors"
    .Refresh
End With

VIII-F-2. Le contrôle DataGrid▲

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseServer
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=D:\user\jmarc\bd6.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseServer
MonRs.Open "reqAdresse", Cnn1, adOpenKeyset, adLockPessimistic, adCmdTable
Set DataGrid1.DataSource = MonRs

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseServer
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\user\jmarc\bd6.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseServer
MonRs.ActiveConnection = Cnn1
MonRs.Properties("IrowsetIdentity") = True
MonRs.Open "reqAdresse", , adOpenKeyset, adLockPessimistic, adCmdTable
Set DataGrid1.DataSource = MonRs

SELECT tab_mere.Nom, tab_mere.Prenom, tab_fille.Adresse, tab_fille.Ville
FROM tab_mere 
            INNER JOIN tab_fille 
                        ON tab_mere.Me_id = tab_fille.Me_id

SELECT Publishers.PubID, Titles.PubID, Publishers.Name, Publishers.[Company Name], Titles.Title, Titles.ISBN, Titles.[Year Published]
FROM Publishers 
    INNER JOIN Titles 
         ON Publishers.PubID = Titles.PubID

Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)

Dim MaComm As ADODB.Command, Recup

If DataError = 6153 Then
    Set MaComm = New ADODB.Command
    With MaComm
        .ActiveConnection = Adodc1.Recordset.ActiveConnection
        .CommandText = "INSERT INTO Publishers (Name,[Company Name]) VALUES('" & Adodc1.Recordset!Name & "','" _ 
            & Adodc1.Recordset![Company Name] & "')"
        .Execute
        .CommandText = "SELECT @@IDENTITY"
        Recup = .Execute
        .CommandText = "INSERT INTO Titles (Title,ISBN,[Year Published],PubId) VALUES('" & Adodc1.Recordset!Title & _
             "','" & Adodc1.Recordset!ISBN & "','" & Adodc1.Recordset![Year Published] & "','" & Recup(0).Value & "')"
        .Execute
    End With
    Set DataGrid1.DataSource = Nothing
    Adodc1.Recordset.CancelUpdate
    Adodc1.Recordset.Requery
    Set DataGrid1.DataSource = Adodc1
    Response = 0
End If

End Sub

Private Sub Form_Load()

Set Cnn1 = New ADODB.Connection
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\user\jmarc\bd6.mdb ;User Id=Admin; Password="
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseServer
MonRs.ActiveConnection = Cnn1
MonRs.Properties("IrowsetIdentity") = True
MonRs.Open "tab_Mere", , adOpenKeyset, adLockPessimistic, adCmdTable
Set DataGrid1.DataSource = MonRs

End Sub

Private Sub Command6_Click()

While Not MonRs.EOF
    If MonRs.Fields("nom").Value = "Durand" Then MonRs.Delete adAffectCurrent
    MonRs.MoveNext
Wend

End Sub

Private Sub Command6_Click()
Dim TempRs As ADODB.Recordset

Set TempRs = DataGrid1.DataSource
While Not MonRs.EOF
    If TempRs.Fields("nom").Value = "Durand" Then TempRs.Delete adAffectCurrent
    MonRs.MoveNext
Wend

End Sub

Celle-ci n'est pas plus complexe que la programmation évènementielle des contrôles. Il faut toutefois garder à l'esprit que le changement de l'enregistrement courant valide les modifications.
Comme un simple Find fait changer l'enregistrement courant, on devine facilement l'intérêt de la programmation asynchrone pour éviter des actions masquées.

Connection et command asynchrone▲

Private Sub Form_Load()

Set Cnn1 = New ADODB.Connection
Cnn1.CursorLocation = adUseServer
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\nwind.mdb ;User Id=Admin; Password=", , , adAsyncConnect
…………

End Sub

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

Dim MaCommand As ADODB.Command

    If adStatus = adStatusErrorsOccurred Then
        MsgBox "Erreur de connexion " & pError.Description
        Unload Me
    Else
        Set MaCommand = New ADODB.Command
        MaCommand.ActiveConnection = Cnn1
        MaCommand.CommandText = "UPDATE Clients Set Pays = 'USA' WHERE Pays = 'États-Unis'"
        Set MonRs = MaCommand.Execute(, , adAsyncExecute)
    End If

End Sub

Private Sub Cnn1_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, _ 
        adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
         ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)

    MsgBox RecordsAffected & " modification(s) exécutée(s)"

End Sub

Extractions bloquantes et non bloquantes▲

Private Sub Command7_Click()
Dim Recup As String, MonSignet As Variant

Set Cnn1 = New ADODB.Connection
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password=" ', , , adAsyncConnect
Set MonRs = New ADODB.Recordset
With MonRs
    .CursorLocation = adUseClient
    .ActiveConnection = Cnn1
    .Properties("Initial Fetch Size") = 50
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    .Open "Titles", , , , adAsyncFetch  'adAsyncFetchNonBlocking
End With
MonRs.MoveLast
Recup = MonRs!Title
MonSignet = MonRs.Bookmark
Set DataGrid1.DataSource = MonRs
MonRs.Bookmark = MonSignet
MsgBox Recup & " " & MonRs.AbsolutePosition

End Sub

Suivre l'extraction▲

Private Sub cmdSuiv_Click()
    Dim MaComm As ADODB.Command
    
    ProgressBar1.Visible = True
    ProgressBar1.Min = 0
    Set MonRs = Cnn1.Execute("SELECT Count(Titles.Title) AS NbRes 
         FROM (Publishers INNER JOIN Titles ON Publishers.PubID = 
         Titles.PubID) INNER JOIN (Authors INNER JOIN [Title Author]
         ON Authors.Au_ID = [Title Author].Au_ID) ON Titles.ISBN = [Title Author].ISBN")
    ProgressBar1.Max = MonRs!NbRes
    MonRs.Close
    Set MonRs = Nothing
    Set MonRs = New ADODB.Recordset
    With MonRs
        .CursorLocation = adUseClient
        .ActiveConnection = Cnn1
        .Properties("Initial Fetch Size") = 100
        .Properties("Background Fetch Size") = 1000
        .Open "[All Titles]", , adOpenStatic, adLockReadOnly, adCmdTable + adAsyncFetchNonBlocking
    End With
    
End Sub

Private Sub MonRs_FetchComplete(ByVal pError As ADODB.Error, _ 
 adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    
    ProgressBar1.Visible = False

End Sub

Private Sub MonRs_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, _
    adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    
    ProgressBar1.Value = Progress  'Debug.Print Progress 'Int((Progress / pRecordset.RecordCount) * 100) '
    
End Sub

Gestion des modifications▲

Private Sub MonRs_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, _ 
    ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  
  Dim bCancel As Boolean

  Select Case adReason
    Case adRsnAddNew
    
    Case adRsnClose
            
    Case adRsnDelete
    
    Case adRsnFirstChange
    
    Case adRsnMove
    
    Case adRsnRequery
    
    Case adRsnResynch
    
    Case adRsnUndoAddNew
    
    Case adRsnUndoDelete
    
    Case adRsnUndoUpdate
    
    Case adRsnUpdate
        
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub MonRs_WillMove(ByVal adReason As ADODB.EventReasonEnum, _ 
    adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

If pRecordset.EditMode = adEditInProgress Or adEditAdd Or adEditDelete Then
    If MsgBox("Voulez vous enregistrer les modifictions", vbQuestion + vbYesNo) = vbYes Then
        pRecordset.Update
    Else
        pRecordset.CancelUpdate
    End If
End If

End Sub

Un recordset persistant est en fait un fichier de type « datagram » ou XML que l'on peut créer à partir d'un Recordset ou ouvrir comme un Recordset. Ceci peut être très intéressant dans les cas suivants :

• Comme sécurité (comme nous allons le voir plus loin)
• Pour alléger la connexion (puisqu'on peut le remettre à jour par re synchronisation)
• Comme base de travail, si la mise à jour n'est pas primordiale

Dans le principe de fonctionnement, c'est assez simple

Private Sub Form_Load()

Set Cnn1 = New ADODB.Connection
Cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password=" 
Set MonRs = New ADODB.Recordset
MonRs.CursorLocation = adUseClient
MonRs.ActiveConnection = Cnn1
MonRs.Open "Authors", , adOpenStatic, adLockBatchOptimistic, adCmdTable

End Sub

Private Sub cmdSave_Click()
    If Dir("d:\monrs.adtg") <> "" Then Kill "d:\monrs.adtg"
    MonRs.Save "d:\monrs.adtg", adPersistADTG
End Sub

Private Sub cmdOpen_Click()
    If MonRs.State = adStateOpen Then MonRs.Close
    MonRs.Open "d:\monrs.adtg", Cnn1, adOpenStatic, adLockBatchOptimistic, adCmdFile
End Sub

Comme vous le voyez, il faut toujours s'assurer qu'il n'existe pas de fichier du même nom sur le disque. Notez aussi qu'un recordset persistant garde l'ensemble des données et des métadonnées, on peut ainsi rendre persistant un recordset ayant des modifications en attente, puis le rouvrir pour appliquer ces modifications sur la base.

Dans mon exemple, j'utilise une connexion pour ouvrir mon Fichier. Cela n'est pas obligatoire, car ADO propose un fournisseur de service pour faire cela, je pourrais donc l'ouvrir avec :

MonRs.Open "d:\monrs.adtg", "Provider=MSPersist;", adOpenStatic, adLockBatchOptimistic, adCmdFile

Quelques précisions sont encore nécessaires :

• Si le recordset a une propriété Filter définie sans que celle-ci soit une constante prédéfinie, seules les lignes accessibles avec ce filtre sont sauvegardées
• Pour sauvegarder plusieurs fois votre recordset, précisez la destination seulement la première fois. Si la deuxième fois, vous redonnez la même destination, vous obtiendrez une erreur, si vous en donnez une autre vous obtiendrez deux fichiers et le premier restera ouvert. La fermeture du fichier n'a lieu que lors de la fermeture du recordset.
• En programmation asynchrone, Save est toujours une méthode bloquante.
• Un recordset persistant garde ses possibilités de modifications sur la base. Toutefois, elles ne peuvent concerner qu'une table si le curseur est côté serveur. De plus, ce type de recordset ne pourra pas être synchronisé.

Lorsqu'on utilise un Recordset sans mise à jour, de type statique ou en avant seulement, il est possible de réactualiser les données de celui-ci. On appelle cette technique la synchronisation. Celle-ci n'est pas possible sur les recordset côté client en lecture seule. Cette méthode est souvent mal utilisée, car son comportement peut sembler étrange, aussi beaucoup de développeurs préfèrent utiliser, à tort, la méthode Requery. Un des problèmes de cette méthode est qu'en fait, elle contient deux méthodes fondamentalement différentes selon les paramètres qu'on lui passe.

Synchronisation des données sous-jacentes▲

Synchronisation des données▲

On Error Resume Next
MonRs1.Resync adAffectAllChapters, adResyncAllValues
If Err.Number = -2147217885 Then
    MonRs1.Filter = adFilterConflictingRecords
    MsgBox MonRs1.RecordCount & " enregistrements ont été supprimés", vbCritical + vbOKOnly, "Erreur"
    Err.Clear
    Exit Sub
End If

Set MonRs1 = New ADODB.Recordset
MonRs1.ActiveConnection = cnn1
MonRs1.Open "SELECT * FROM Authors", cnn1, adOpenStatic, adLockOptimistic, adCmdText
MonRs1![Year born] = 1921
MonRs1.Resync adAffectCurrent, adResyncUnderlyingValues

Comme nous allons le voir, voilà un passage « sensible » de la programmation ADO. L'intérêt du travail par lot n'est plus à démontrer, mais il faut gérer soigneusement la mise à jour de la base afin de ne pas endommager celle-ci. Grosso modo, il existe trois sortes de traitement par lot :

• Le traitement sécurisé : Il se fait par une connexion exclusive à la source de données (en général en dehors des heures d'accès). Il n'est dans ce cas pas nécessaire de gérer la concurrence et il peut contenir des procédures assez lourdes.
• Le traitement sans contrôle : Il n'y a pas de contrôles sur les mises à jour en échec. Ce type de traitement est assez rare, mais ne demande aucune gestion par le code.
• Le traitement transactionnel : C'est le cas le plus fréquent, mais aussi le plus délicat à gérer. Nous allons donc étudier un exemple.

Remarque préliminaire :

Décomposition de Status

La valeur de la propriété Status peut être la somme de plusieurs des constantes données plus haut. Nous allons donc utiliser la fonction de décomposition donnée ci-dessous

Private Function Decomp_Status(ByVal ValStatus As Long) As Long()

Dim PEnt As Integer, Retour() As Long

ReDim Retour(0 To 0)
Do While ValStatus > 0
    PEnt = Int(Log(ValStatus) / Log(2))
    Retour(UBound(Retour)) = 2 ^ PEnt
    ReDim Preserve Retour(0 To UBound(Retour) + 1)
    ValStatus = ValStatus - 2 ^ PEnt
Loop
Retour(UBound(Retour)) = 0
Decomp_Status = Retour

End Function

Cette fonction renvoie un tableau de long contenant les valeurs des constantes de la propriété Status.

Transaction

On est parfois tenté d'englober le traitement par lot dans une transaction afin de pouvoir revenir en arrière en cas d'échec partiel du traitement. Malheureusement cette méthode assez simple ne fonctionne pas, du moins avec certains fournisseurs. On doit donc écrire l'ensemble du code qui gère l'intégrité de la source de données.

Règles de traitement

Avant toute écriture de code, il faut avoir défini les règles de comportement que le traitement par lot doit suivre. Cette phase est indispensable afin de ne jamais pouvoir endommager la source de données. Dans l'exemple ci-dessous, je vais faire un traitement qui suit les règles suivantes.

• Si un enregistrement concerné par le traitement a été supprimé, la mise à jour de cet enregistrement est annulée.
• Si une mise à jour échoue de la faute du verrouillage, l'enregistrement sera retraité à la volée
• Si une autre erreur se produit, toute l'opération sera annulée

Exemple

Pour voir le fonctionnement de la résolution des conflits, nous allons simuler par le code, une action de deux utilisateurs. Dans cet exemple nous allons voir de nombreuses techniques expliquées au-dessus, n'hésitez pas à vous y reporter de nouveau.

Dim Reponse() As Long, compteur As Long

'première connexion
Set AutreCnn = New ADODB.Connection
With AutreCnn
    .CursorLocation = adUseServer
    .Mode = adModeShareDenyNone
    .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password="
End With
Set AutreRs = New ADODB.Recordset
With AutreRs
    .CursorLocation = adUseServer
    .ActiveConnection = AutreCnn
    .CursorType = adOpenKeyset
    .LockType = adLockPessimistic
    .Source = "SELECT * From Authors WHERE [year born] IS NOT NULL"
    .Open
End With

'seconde connexion
Set MaCnn = New ADODB.Connection
With MaCnn
    .CursorLocation = adUseClient
    .Mode = adModeShareDenyNone
    .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\biblio.mdb ;User Id=Admin; Password="
End With
Set MonRs = New ADODB.Recordset
With MonRs
    .CursorLocation = adUseClient
    .ActiveConnection = MaCnn
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    .Source = "SELECT * From Authors WHERE [year born] IS NOT NULL"
    .Open
End With

J'ai donc créé deux connexions, une côté serveur qui va me servir à perturber mon traitement, et une côté client que j'utilise pour le traitement par lot.

'modification de perturbation
While Not AutreRs.EOF
    'modification de quelques dates
    If AutreRs.Fields("year born").Value = 1947 Then AutreRs.Fields("year born").Value = 1932
    AutreRs.MoveNext
Wend
AutreRs.MoveLast
'suppression du dernier enregistrement
AutreRs.Delete adAffectCurrent
'modification de mon utilisateur par lot
While Not MonRs.EOF
    If MonRs.Fields("year born").Value < 1951 Then MonRs.Fields("year born").Value = MonRs.Fields("year born").Value + 1
    MonRs.MoveNext
Wend

Ici j'ai fait mes modifications, je procède maintenant au traitement par lot

'Vérification préliminaire
MonRs.Resync adAffectAllChapters, adResyncUnderlyingValues
MonRs.Filter = adFilterPendingRecords
'traitement préliminaire (non utilisé dans l'exemple)

'*****DEBUT TRAITEMENT*****
'While Not MonRs.EOF
'    If MonRs.Fields("year born").OriginalValue <> MonRs.Fields("year born").UnderlyingValue Then
'        MsgBox "Au moins un enregistrement a été modifié par un autre utilisateur" & -
'         vbCrLf & "Opération annulée", vbCritical + vbOKOnly
'        MonRs.CancelBatch
'        Exit Sub
'    End If
'    MonRs.MoveNext
'Wend
'*****FIN TRAITEMENT*****

'création d'un recordset de sauvegarde
If Dir("d:\RsSauve.adtg") <> "" Then Kill "d:\RsSauve.adtg"
MonRs.Save "d:\RsSauve.adtg", adPersistADTG
'mise à jour + résolution des conflits
MonRs.Properties("Update Resync") = adResyncConflicts
On Error Resume Next
MonRs.UpdateBatch
If MonRs.ActiveConnection.Errors.Count > 0 Then
    MonRs.Filter = adFilterConflictingRecords
    Do While Not MonRs.EOF
        Reponse = Decomp_Status(MonRs.Status)
        For compteur = LBound(Reponse) To UBound(Reponse)
            Select Case Reponse(compteur)
                Case adRecOK, adRecModified 'mise à jour réussie

                Case adRecConcurrencyViolation, adRecCantRelease 'enregistrement modifié ou verrouillé
                    If MonRs.Fields("year born").UnderlyingValue < 1951 Then
                        MonRs.Fields("year born").Value = MonRs.Fields("year born").UnderlyingValue + 1
                    End If

                Case adRecDBDeleted 'enregistrement supprimé
                    MonRs.CancelUpdate
                    Exit For

                Case Else 'Autres erreurs
                    Annulation = True
                    Exit For

            End Select
        Next compteur
        If Annulation Then Exit Do
        MonRs.MoveNext
    Loop
    If Annulation Then 'restaure les valeurs d'origine
        MonRs.Close
        Set MonRs = New ADODB.Recordset
 MonRs.Open "d:\RsSauve.adtg", MaCnn, , , adCmdFile
        MonRs.Resync adAffectAllChapters, adResyncUnderlyingValues
        MonRs.Filter = adFilterAffectedRecords
        Do While Not MonRs.EOF
            If MonRs.Fields("year born").UnderlyingValue = MonRs.Fields("year born").Value Then
                MonRs.Fields("year born").Value = MonRs.Fields("year born").OriginalValue
            End If
            MonRs.MoveNext
        Loop
    End If
    'exécute la validation ou l'annulation
    MonRs.Properties("Update Criteria") = adCriteriaKey
    MonRs.UpdateBatch adAffectGroup
End If
Err.Clear
On Error GoTo 0

End Sub

Regardons tout cela en détail. Je vous ai mis en commentaires au début un exemple de traitement préliminaire. Dans cet exemple pourtant simple, car les modifications ne portent que sur un champ d'une seule table, le codage est déjà assez lourd. Beaucoup de développeurs préfèrent garder un modèle transactionnel strict (atomicité) est rejettent l'ensemble du traitement si un enregistrement au moins ne peut être mis à jour. Dans ce cas, le traitement préliminaire permet de détecter une cause d'annulation avant le début des mises à jour.

Ensuite j'applique la stratégie générale qui consiste à garder une copie du recordset avant la transmission des modifications. Je vais donc créer un recordset persistant. Le fait de garder un recordset persistant peut paraître aberrant, mais il est obligatoire lors de traitement par lot avec un curseur client. Nous avons vu que le moteur de curseur utilise les propriétés OriginalValue des champs pour écrire ses requêtes actions. C'est propriétés, qui pour le coup porte mal leurs noms se remettent à jour lors de la réussite d'une modification. Après l'appel de UpdateBatch, il n'est donc plus possible de connaître la valeur qu'avait le champ avant la mise à jour. Le recordset persistant permet de pouvoir restaurer.

Avant d'appeler la méthode UpdateBatch je déclenche la récupération d'erreur. En effet nous avons dit que l'échec d'une mise à jour provoque l'apparition d'une erreur ainsi que la valorisation de la collection Errors de l'objet Connection. Si au moins une erreur apparaît dans la collection, je rentre alors dans mon code de gestion.

La procédure est alors simple. Je filtre pour obtenir un recordset des enregistrements ayant échoué leurs mises à jour et je décompose leur propriété Status. Cette décomposition est obligatoire puisque tous les enregistrements seront au moins marqué comme la somme du statut modifié et de l'erreur. Je gère ensuite les cas.

Vous pouvez noter aussi que pour contourner le verrouillage je modifie la propriété « Update Criteria ».

Cet exemple ne présente qu'une des techniques de gestion d'erreurs. Il est plus fréquent de rencontrer des traitements à l'aide de l'objet Command.