UTILISATION DE XML AVEC VB LECTURE ECRITURE DE FICHIERS XML

Option Explicit

Private Const NomDirTmpXml  As String = "C:\temp\XMLFichier.xml"

Private ObjRecClients            As ADODB.Recordset

Private IdentIDT As Long

Private Sub CreerLeRec()

        Set ObjRecClients = New ADODB.Recordset

        With ObjRecClients.Fields
                .Append ("NumId"), adWChar, 25, adFldRowID
                .Append ("Nom"), adWChar, 65, adFldLong
                .Append ("Prenom"), adWChar, 65, adFldLong
                .Append ("Titre"), adWChar, 60, adFldLong
                ObjRecClients.Open
        End With
        
End Sub

Private Sub AjoutAuRecordSetXml(Nom As String, Prenom As String, Titre As String, Optional MiseAjour As Boolean)
                        
        If MiseAjour Then
                If ObjRecClients Is Nothing Then Set ObjRecClients = OuvreXMLSeul
        End If
        
        With ObjRecClients
                
                IdentIDT = IdentIDT + 1
                
                .AddNew
                .Fields("NumId").Value = CStr(IdentIDT)
                .Fields("Nom").Value = Nom
                .Fields("Prenom").Value = Prenom
                .Fields("Titre").Value = Titre
                
                If MiseAjour Then
                        .UpdateBatch
                         EnregistreXML ObjRecClients
                End If
        
        End With
        
End Sub


Private Sub EnregistreXML(LeRecordSet As ADODB.Recordset)
        
        'Le fichier étant présent dans NomDirTmpXml il est impératif en cas de
        'rechargement complet de supprimer ce fichier avant de le créer.
        
        On Error Resume Next
                Kill NomDirTmpXml
        On Error GoTo 0
        
        'L'option adPersistXML est simplement à préciser
        LeRecordSet.Save NomDirTmpXml, adPersistXML
        LeRecordSet.Close
        Set LeRecordSet = Nothing
        
End Sub

Private Function OuvreXMLSeul() As Recordset
Dim LeRecordSet As New ADODB.Recordset
        
        'Ouvrir tout simplement en passant en param le chemin
        LeRecordSet.Open NomDirTmpXml
        Set OuvreXMLSeul = LeRecordSet
             
End Function

Private Sub Cmdadd_Click()
        AjoutAuRecordSetXml Me.TextNom, Me.TextPrenom, Me.TextTitre, True
End Sub

Private Sub Form_Load()
        CreerLeRec 'En 1°)
        EnregistreXML ObjRecClients ' en 2°) l'enregistrer en local
End Sub