Conversion Excel -> XML

Sub exportTableFeuille_XML()
    Dim Cn As ADODB.Connection
    Dim Rs As ADODB.Recordset
    Dim Fichier As String
 
    Fichier = "C:\Documents and Settings\mimi\NomClasseur.xls"
 
    Set Cn = New ADODB.Connection
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;"
        .Open
    End With
 
    Set Rs = New ADODB.Recordset
    With Rs
        .ActiveConnection = Cn
        .Open "SELECT * FROM [Feuil1$]", , _
            adOpenStatic, adLockOptimistic, adCmdText
    End With
 
    Rs.Save "C:\exportTable.xml", adPersistXML
 
    Cn.Close
    Set Cn = Nothing
End Sub