Export Exel dans Access (*.accdb) via VBA

Version imprimable

Bonjour,

Je début dans le code VBA pour export Access. J'ai réussi à exporter des données Excel sous Access avec un Access au format *.mdb. En revanche, je ne trouve pas la solution pour export sous accdb.

Pouvez-vous m'aider?

Ci-dessous le code fonctionnant

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
      Dim Plage   As Range
      Dim Array1   As Variant
      Dim x   As Variant
      Dim Db1   As Database
      Dim Rs1   As Recordset
 
      ' Ouverture de la base de données Commandes.mdb
 
      Set Db1 = DBEngine.OpenDatabase(Adr_BD & Nom_BD)
 
      ' Ouverture de la table
      ' Un objet Recordset représente les enregistrements d'une table
 
      Set Rs1 = Db1.OpenRecordset(table_BD, dbOpenDynaset)
 
      ' Ecriture des données depuis Excel vers Access
 
 
           With Rs1
 
               .AddNew
               .Fields("Nom_BDU") = Cells(2, 2)
               .Fields("Num_DE") = Cells(3, 2)
               .Fields("Nom_TSE") = Cells(4, 2)
               .Fields("Nom_demandeur") = Cells(5, 2)
               .Fields("Sce_demandeur") = Cells(6, 2)
               .Fields("NQL") = Cells(7, 2)
               .Fields("NQI") = Cells(8, 2)
               .Fields("NQA") = Cells(9, 2)
               .Fields("NDI") = Cells(10, 2)
               .Fields("NPQ") = Cells(11, 2)
               .Fields("NRhC") = Cells(12, 2)
               .Fields("CQL") = Cells(13, 2)
               .Fields("CQI") = Cells(14, 2)
               .Fields("CQA") = Cells(15, 2)
               .Fields("CDI") = Cells(16, 2)
               .Fields("CPQ") = Cells(17, 2)
               .Fields("CRhC") = Cells(18, 2)
               .Fields("Moyenne") = Cells(19, 2)
               .Update
 
           End With
 
 
 
      ' Fermeture de la base Commandes.mdb
 
     Db1.Close

Bonjour!
Je me suis moi-même beaucoup battue avec les imports Excel-Access. Ma solution est sans doute loin d'être idéale, mais voici ce que j'avais fait (peut-être que ça te donnera des idees):

Dans Excel:
Code:

1 2 3 4 5 6 7 8 Sub updateAccess() Dim acApp As Access.Application Set acApp = New Access.Application acApp.OpenCurrentDatabase ("Adresse\nom fichier Access.accdb") 'ouvre bdd Access acApp.Run ("'adresse\nom fichier access.accdb'!importData") 'appel méthode dans Access acApp.CloseCurrentDatabase 'ferme BDD Set acApp = Nothing End Sub
Dans Access:
Code:

1 2 3 Sub importData() DoCmd.TransferSpreadsheet acImport, , "NomTable", "Adresse\nom fichier Excel", True, "[Nom feuille du classeur]!" End Sub
PS: je vois que tu es nouveau. Bienvenue :) La prochaine fois que tu as une question concernant VBA, pose-la sur le forum dédié à VBA (une fois que tu es sur le forum Excel, tu peux choisir d'aller plus précisemment vers le forum VBA).

07/03/2017, 11h40
castiron

Bonjour,

Merci pour ce retour rapide. et merci pour le conseil.

Je vais essayer de tester cela cette après-midi.

J'espère que cela va fonctionner, dans la mesure ou je pousse actuellement des infos d'Excel vers Access et cela pour une partie des utilisateurs sans avoir Access installé sur leurs poste de travail.

En //, j'ai beaucoup d'utilisateurs, et du coup l'emplacement n'est pas figée.....

Bonjour,

J'ai trouvé ma solution!

je vous la partage donc :

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
 
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, row As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=" & Adr_BD & Nom_BD & ";"
 
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open table_BD, cn, adOpenKeyset, adLockOptimistic, adCmdTable
 
    'row = 3    ' the start row in the worksheet
    'Do While Not IsEmpty(Worksheets("FeuilleTravail").Range("B" & row))
 
 
        With rs
            .AddNew    ' create a new record
               .Fields("Nom_BDU") = Sheets("FeuilleTravail").Cells(2, 2)
               .Fields("Num_DE") = Sheets("FeuilleTravail").Cells(3, 2)
               .Fields("Nom_TSE") = Sheets("FeuilleTravail").Cells(4, 2)
               .Fields("Nom_demandeur") = Sheets("FeuilleTravail").Cells(5, 2)
               .Fields("Sce_demandeur") = Sheets("FeuilleTravail").Cells(6, 2)
               .Fields("NQL") = Sheets("FeuilleTravail").Cells(7, 2)
               .Fields("NQI") = Sheets("FeuilleTravail").Cells(8, 2)
               .Fields("NQA") = Sheets("FeuilleTravail").Cells(9, 2)
               .Fields("NDI") = Sheets("FeuilleTravail").Cells(10, 2)
               .Fields("NPQ") = Sheets("FeuilleTravail").Cells(11, 2)
               .Fields("NRhC") = Sheets("FeuilleTravail").Cells(12, 2)
               .Fields("CQL") = Sheets("FeuilleTravail").Cells(13, 2)
               .Fields("CQI") = Sheets("FeuilleTravail").Cells(14, 2)
               .Fields("CQA") = Sheets("FeuilleTravail").Cells(15, 2)
               .Fields("CDI") = Sheets("FeuilleTravail").Cells(16, 2)
               .Fields("CPQ") = Sheets("FeuilleTravail").Cells(17, 2)
               .Fields("CRhC") = Sheets("FeuilleTravail").Cells(18, 2)
               .Fields("UET_TSE") = "DEATVR3"
            .Update
        End With
'        row = row + 1
'    Loop
 
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
 
   Dim cn As ADODB.Connection, rs As ADODB.Recordset, row As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=" & Adr_BD & Nom_BD & ";"
SQL ="INSERT INTO toto (Nom_BDU,Num_DE,Nom_TSE,Nom_demandeur,Sce_demandeur,NQL,NQI,NQA,NDI,NPQ,NRhC,CQL,CQI,CQA,CDI,CPQ,CRhC,UET_TSE)"  
SQL=SQL & " SELECT (Nom_BDU,Num_DE,Nom_TSE,Nom_demandeur,Sce_demandeur,NQL,NQI,NQA,NDI,NPQ,NRhC,CQL,CQI,CQA,CDI,CPQ,CRhC,'DEATVR3' as UET_TSE)"
SQL=SQL & " FROM [toto$] IN '" & ThisWorkbook.FullName & "'[Excel 12.0;HDR=YES;];"
cn.execute SQL