Fonction ADODB = problème

[nak]

Bonjour à tous,

Malgré mes multiples essais j'ai toujours du mal à utiliser la fonction ADODB :-(
Je pense que j'oublie toujours quelque chose mais quoi...
En tout cas j'obtiens l'erreur systeme &H80040E37.

Voici mon code :

Sub Fermer_et_sauvegarder()

'Transfert vers fichier base
'Call Transfert_base
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Dim VSearch As String, i As Integer

' Chemin d'accès de la base
Fichier = ThisWorkbook.Path & "\base.xls"
' Créer la connexion
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
' Ouvrir 1000 lignes d'enegistrement
Cd.CommandText = "SELECT * FROM [Feuil1$A1:Z1000]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
' Chercher la valeur dans la BdD
Rst.Find "F1 = '" & Range("G9") & "'", , adSearchForward, 1
' Si on se retrouve à la fin des enregistrement
' On en créé un nouveau
If Rst.EOF = True Then Rst.AddNew
' On rempli la ligne d'enregistrement avec les valeurs
For i = 0 To 25 ' Mettre ici le nombre de champs -1
Rst(i).Value = Sheets("Transfert").Cells(1, 1 + i)
Next i
' Metre à jour la ligne d'enregistrement
Rst.Update
' Fermer la connexion
Cn.Close
' Effacer les variables objet
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing


'sauvegarder
ActiveWorkbook.Save

'fermer
Autoriser_Fermeture = True
ActiveWorkbook.Close

End Sub

Je vous joins également deux petits fichiers pour test.

Pouvez vous m'aider SVP ?

Merci