Copier des données de Access vers Excel

**benoaa** · 04/07/2014, 13h19

Bonjour à tous,

Je souhaiterais copier dans un fichier excel des enregistrements présents dans une base de données access. Je possède les chemins d'accès de ces deux fichiers. Je ne sais pas comment m'y prendre pour copier les données de l'un à l'autre. Voici mon code argumenté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub copie()
 
  Dim accChemin As String ' Chemin de la base de données
  accChemin = "C:\mon Chemin ...accdb"
  Dim MonAccess As New Access.Application
  MonAccess.OpenCurrentDatabase (accChemin)
 
  Dim xlChemin As String ' Chemin du fichier excel
  xlChemin = "C:\ mon chemin ... xlsx"
 
  Dim app As Excel.Application
  Dim wkb As Excel.Workbook
  Dim wks As Excel.Worksheet
 
  Set app = New Excel.Application
  Set wkb = app.Workbooks.Open(xlChemin)
  Set wks = wkb.Worksheets("Feuil1")
 
  Dim SQL As String
 
'active la routine de gestion d'erreur.
On Error GoTo erreur
 
    'pour éviter les messages lors de l'ajout des enregistrements
    DoCmd.SetWarnings False
 
'*********************************************************
 
        SQL = "SELECT champ1, champ2 FROM MaTable1"
        'COPIER CES DONNEES dans le fichier excel feuil1, ligne1
 
        SQL = "SELECT champ3, champ4 FROM MaTable2"
        'COPIER CES DONNEES A LA SUITE DU FICHIER EXCEL feuil1
 
'*********************************************************
 
    'on réactive les messages d'erreurs
    DoCmd.SetWarnings True
 
        'On libère l'ensemble des variables
        Set wks = Nothing
        Set wkb = Nothing
        Set app = Nothing
        MonAccess.Quit acQuitSaveNone
        Set MonAccess = Nothing
 
    Exit Sub
 
erreur:    ' Routine de gestion d'erreur.
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation
 
End Sub

Pourriez vous m'aider à combler le bloc entre étoiles, en utilisant peut être un With ou tout autre idée.
Merci à tous pour vos suggestions

BH

Invité · 04/07/2014, 13h31

Bonjour

As-tu consulté la FAQ Access : http://access.developpez.com/faq/?page=Excel

Il y a déjà pleins d'informations.

Un tuto intéressant à lire également : http://cafeine.developpez.com/access/tutoriel/excel/

De plus en faisant une recherche sur le forum Access avec le mot Excel il y a une grande quantité de discussions sur le sujet.

Commence déjà la lecture du tuto et de la FAQ, tu commenceras à y voir plus clair.

Philippe

**benoaa** · 04/07/2014, 14h00

Merci pour ces différents liens, j'avais déjà lu les deux premiers, mais dans les exemples proposés, on insére les données case par case dans le fichier Excel, y a t-il un moyen pour réaliser un "copier-coller" direct ?

Faut-il également que je passe par DAO?

Cdl,

B

**chrtophe** · 04/07/2014, 14h07

Voici un code que j'utilise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Export_excel()
Dim xlapp As Object
Dim xlwb As Object
Dim xlsh As Object
 
Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Add
Set xlsh = xlwb.Worksheets(1)
Set rs = Me.Recordset
 
xlsh.Range("A1").SELECT
intCount = 0
Do Until intCount = rs.Fields.Count
        xlapp.ActiveCell = rs.Fields(intCount).Name
        xlapp.ActiveCell.Offset(0, 1).SELECT
        intCount = intCount + 1
Loop
 
rs.MoveFirst
xlsh.Range("A2").CopyFromRecordset rs
 
xlsh.Range("1:1").SELECT
xlapp.Selection.Font.Bold = True
xlsh.Range("A1").SELECT
xlapp.Visible = True
 
End Sub

Je copie les données dans un doc excel vierge. Tu peux l'adapter.

Le code est assez facile à comprendre.

**benoaa** · 04/07/2014, 14h20

Merci pour ces informations mais je ne vois pas comment le code interragit avec la base de données. Pourriez-vous m'expliquer.

Cdl,

B

**benoaa** · 04/07/2014, 14h59

J'ai changé le bloc central pour ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub copie()
 
  Dim accChemin As String ' Chemin de la base de données
  accChemin = "\monchemin.mdb"
 
  Dim MonAccess As DAO.Database
  Set MonAccess = DAO.OpenDatabase(accChemin)
  Set Rs = DAO.Recordset
 
  Dim xlChemin As String ' Chemin du fichier excel
  xlChemin = "C:\ mon chemin ... xlsx"
 
  Dim app As Excel.Application
  Dim wkb As Excel.Workbook
  Dim wks As Excel.Worksheet
 
  Set app = New Excel.Application
  Set wkb = app.Workbooks.Add(xlChemin)
  Set wks = wkb.Worksheets(1)
 
  Dim SQL As String
 
'active la routine de gestion d'erreur.
On Error GoTo erreur
 
    'pour éviter les messages lors de l'ajout des enregistrements
    DoCmd.SetWarnings False
 
'*********************************************************
 
        SQL = "SELECT champ1, champ2 FROM MaTable1"
        Set Rs = MonAccess.OpenRecordset(SQL, DAO.dbOpenSnapshot)
        wks.Range("A1").CopyFromRecordset Rs
 
        SQL = "SELECT champ3, champ4 FROM MaTable2"
        Set Rs = MonAccess.OpenRecordset(SQL, DAO.dbOpenSnapshot)
        wks.Range("A1").End(xlDown).Row.CopyFromRecordset Rs
 
'*********************************************************
 
    'on réactive les messages d'erreurs
    DoCmd.SetWarnings True
 
        'On libère l'ensemble des variables
        Set wks = Nothing
        Set wkb = Nothing
        Set app = Nothing
        MonAccess.Quit acQuitSaveNone
        Set MonAccess = Nothing
 
    Exit Sub
 
erreur:    ' Routine de gestion d'erreur.
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation
 
End Sub

Qu'en pensez vous? Est-ce-que cela pourrait fonctionner? J'ai déjà une première erreur sur mon DAO.Recordset ligne 8 qui me dit : Membre de méthode ou de données introuvables pourtant je suis sur de mon chemin d'access à la base.

Cdl,

B