[FAQ] Comment faire transiter les données d'une base a une autre ADO et recordset

[zeste]

Bonjour,
Je suis plutot débutant et apres avoir cherché dans les tutos, FAQ, Forum VB Forum Access et aupres de mes relations. Je trouvais assez interessant de piloter depuis une Bd2, l'acquisition des données de la Bd1 pour les mettre dans une Bd3 sans que la Bd2 n'est aucune table ou requete objet créer sur le principe d' l'interface utilisateur ne contenant que du code.

La bdd Pilot contient un module avec la function

La Bdd source contient une Table Feuille1import avec 2 champs (Champ1 et champ2)
La BddCible contient une table Feuille3import 2 deux champs (Champ3 et Champ4)


Voici le code

Code :

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

Zeste

[Muhad'hib]

Salut,

Comme tu reste 100% Access (tes 3 bases sont ACCESS) je pencherais plus pour une méthode DAO que ADO. Je trouve plus simple à manipuler.

De plus dans ton cas particulier, je pense qu'il y a plus simple :

Code :

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
Sub DvpPtCom()
Dim Db As Object
 
Dim BddSource As String, BddCible As String, BddPilot As String
Dim Sql As String
 
   On Error GoTo DvpPtCom_Error
 
'Arborescence SI
BddSource = "C:\Test2\Bd1.mdb"
BddCible = "C:\Test2\Bd3.mdb"
 
 
Sql = " INSERT INTO Feuille3import ( Champ3, champ4 ) IN '" & BddCible & "' SELECT Champ1, Champ2 FROM Feuille1import;"
Set Db = OpenDatabase(BddSource)
Db.Execute Sql
 
DvpPtCom_Exit:
Set Db = Nothing
     Exit Sub
 
DvpPtCom_Error:
    MsgBox "Erreur inatendue N°" & Err.Number & " (" & Err.Description & ") dans la fonction/procedure DvpPtCom du module Module1"
    GoTo DvpPtCom_Exit:
 
End Sub

A+