1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
|
Public Function ConnectandaddbyrecordsetADO() As Integer
Dim Vblerreur As String
On Error GoTo erreur:
'Déclaration des variables
Dim Db As Database
Dim Rst1 As ADODB.Recordset, Rst3 As ADODB.Recordset
Dim Cnx1 As ADODB.Connection, Cnx3 As ADODB.Connection
Dim BddSource As String, BddCible As String, BddPilot As String
'Arborescence SI
BddSource = "C:\Test2\Bd1.mdb"
BddCible = "C:\Test2\Bd3.mdb"
BddPilot = "C:\Test2\Bd2.mdb"
'connexion vers la bddSource
Set Cnx1 = New ADODB.Connection
'Définition du pilote de connexion
Cnx1.Provider = "Microsoft.Jet.Oledb.4.0"
'Définition de la chaîne de connexion
Cnx1.ConnectionString = BddSource
'Ouverture de la base de données
Cnx1.Open
' information issu de http://access.developpez.com/faq/?page=SQL#Recordset
Set Rst1 = New ADODB.Recordset
'Exécution de la requête en mémoire pour collecter les données sur la Bdd Source
Rst1.Open "SELECT Champ1, Champ2 FROM Feuille1import", Cnx1
'Envoi des données dans la Bdd Cible
'Connexion vers la bddCible
Set Cnx3 = New ADODB.Connection
'Définition du pilote de connexion
Cnx3.Provider = "Microsoft.Jet.Oledb.4.0"
'Définition de la chaîne de connexion
Cnx3.ConnectionString = BddCible
'Ouverture de la base de données
Cnx3.Open
'********************
Set Rst3 = New ADODB.Recordset
Rst3.Open "Select * From Feuille3import", Cnx3, adOpenKeyset, adLockOptimistic
'se placer sur le premier tuplet
Rst1.MoveFirst
'Faire tant que la totalité de Rst1 n'est pas parcouru
While Not (Rst1.EOF)
Rst3.AddNew
Rst3!Champ3 = Rst1!Champ1
Rst3!champ4 = Rst1!Champ2
Rst3.Update
Rst1.MoveNext
Wend
'La totalité de l'espace de la zone tampon associée au fichier fermé est libérée.
'l'association d'un fichier avec son numéro de fichier est désactivée.
Rst1.Close
Rst3.Close
Cnx1.Close
Cnx3.Close
'ressources mémoire et système associées à l'objet auquel
'les variables font références sont libérées
'pour éviter les erreurs d'insufisance d'espace, de piles ...
Set Rst1 = Nothing
Set Rst3 = Nothing
Set Cnx1 = Nothing
Set Cnx3 = Nothing
Exit Function
'Gestion de l'erreur
erreur:
Vblerreur = Err.Number & Err.Description
MsgBox (Vblerreur)
Exit Function
End Function |
Partager