Exporter donnees Excel dans Access VBA

Version imprimable

Bonjour,

Débutante en programmation, je souhaiterai exporter des données d’un tableur Excel d’une seule feuille vers une table Access contenant les mêmes en-têtes de colonnes. C’est une exportation de nombreuses lignes à réaliser quotidiennement et je souhaite garder toutes mes données antérieures sur Access (en gros je me serts d'Access comme lieu de stockage de mes données Excel pour l’année).
Grâce aux différentes infos trouvées sur les forums notamment j’ai pu trouver certains codes que j’ai adaptés à ma situation. Le code est le suivant :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub test() Dim appAccess As Object Dim aPath, aDbase, aDSource, aTable, exePath As String Dim fileParam As String aPath = ActiveWorkbook.Path aDbase = "Database1.accdb" aDSource = aPath & "\" & aDbase Set appAccess = CreateObject("Access.Application") appAccess.Visible = True appAccess.OpenCurrentDatabase aDSource Const acExport = 0 Const acSpreadsheetTypeExcel12 = 9 appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "table test", "C:\Users\a0h35300\Documents\Database1.accdb", True, "" Application.DisplayAlerts = False ThisWorkbook.Saved = True Application.Quit Exit Sub End Sub
Cette macro ne prend pas du tout les données ni les en-têtes contenues dans mon tableur pour les copier dans ma table Access.
Par contre elle m’ouvre un nouveau document Excel avec les données et les en-têtes des colonnes de ma table (qui sont donc vides mais j’ai fais des tests et ca prend bien toutes les données de ma table quand il y en a).

Du coup comment faire pour basculer les données Excel sur une table Access ? :roll:

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
Dim Sql As String, Cn As Object
Set Cn = CreateObject("Adodb.connection")
With Cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
        Sql = "INSERT INTO [table test] select frm.* FROM [Feuil1$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' "
        .Execute Sql
        .Close
    End With
    Set Cn = Nothing
End Sub

21/07/2016, 14h44
Borsec28

Merci beaucoup rdurupt, ca fonctionne tres bien ! :D :D

Aurais tu une astuce pour ouvrir mon fichier Access et supprimer les donnees de mon fichier excel une fois tranferees? Si possible, j'aimerai un msgbox me demandant confirmation avant
21/07/2016, 15h06
Invité

Vue que tu Exporte d'excel vers Access pourquoi ne pas le faire dans la foulé via Excel?
21/07/2016, 15h10
Borsec28

C'est exactement ce que je cherche a faire: avoir un code VBA a la suite de mon exportation qui me demande si tout a bien ete transfere. Si je valide alors cela supprime les donnees de mon classeur excel. Sinon les donnees restent dans mon classeur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
Dim Sql As String, RsClub As Object, Cn As Object, Rs As Object, sh As Worksheet
Set Cn = CreateObject("Adodb.connection")
With Cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
       Set Rs = CreateObject("Adodb.recordset")
        Sql = "Select count(*)From [table test]"
        Rs.Open Sql, Cn
        nb = Rs(0)
        Rs.Close
        Sql = "INSERT INTO [table test] select frm.* FROM [Feuil1$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' "
        .Execute Sql
         Set Rs = CreateObject("Adodb.recordset")
        Sql = "Select count(*)From [table test]"
        Rs.Open Sql, Cn
        If MsgBox("Voulez vous Vider le fichier Excel", vbQuestion + vbYesNo, "Enregistrements Ajoutés(" & Rs(0) - nb & ")") = vbYes Then ThisWorkbook.Sheets("Feuil1").Range("A2:D" & ThisWorkbook.Sheets("Feuil1").UsedRange.Rows.Count).EntireRow.Delete
        Rs.Close
        .Close
    End With
    Set Cn = Nothing
End Sub

22/07/2016, 07h38
Borsec28

Merci encore

J'ai un probleme avec nb=Rs(0) avec comme message d'erreur "Variable not defined".
En quoi dois-je la declarer ?
22/07/2016, 09h11
Invité

Bonjour,

Code:

Dim Sql As String, Cn As Object, Rs As Object, sh As Worksheet,nb as long
22/07/2016, 12h55
Borsec28

Effectivement ca fonctionne mieux !
Par contre a chaque nouvelle importation une nouvelle table s'ouvre avec toute une liste d'erreurs "Type Conversion Failure" et la colonne et la ligne concernees. Autrement mes importations se deroulent bien correctement. Comment faire pour que toutes ces tables ne se creent plus ? :roll:

Merci pour la reponse

Bonjour,
à l'origine la table à été créée par un import Excel ou autre! bref c'est Access qui à choisi le format des champs et ADO propose sans doute un autre format.
je te suggère de supprimer ou renommer ta table dans Access et on va laisser ADO faire le travail!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub testCreateTable() Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb" Dim Sql As String, RsClub As Object, Cn As Object, Rs As Object, sh As Worksheet Set Cn = CreateObject("Adodb.connection") With Cn .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";" .Open Sql = "select frm.* FROM [Feuil1$] as frm in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' INTO [table test] " .Execute Sql .Close End With Set Cn = Nothing End Sub

J'ai créé une nouvelle table vide nommee TableRealisation2. Mais j'ai un message d'erreur de syntax "in FROM clause" sur ".Execute Sql"

Je n'ai aucune idee de ce que ca peut signifier

Mon code est du coup

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub NouvelleTable()

Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
Dim Sql As String, RsClub As Object, Cn As Object, Rs As Object, sh As Worksheet
Set Cn = CreateObject("Adodb.connection")
With Cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
            Sql = "select frm.* FROM [Data$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;'  INTO [tableRealisation2] "
        .Execute Sql
        .Close
    End With
    Set Cn = Nothing
End Sub

dessolé il y avait un erreur dans la requête! non ne rajoutes pas de table vide mais exécutes le code tel quel!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub testCreateTable()
Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
Dim Sql As String, Cn As Object
Set Cn = CreateObject("Adodb.connection")
With Cn
                .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
        Sql = " select frm.* INTO [table_test_RD] FROM [Feuil1$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' "
        .Execute Sql
        .Close
    End With
    Set Cn = Nothing
End Sub

La creation de la nouvelle table fonctionne, par contre mes datas sont importees dans mes 2 tables (l'ancienne et la nouvelle creee) et j'ai maintenant 2 tables d'erreur qui s'ouvrent a chaque transfert..:?

mon code est le suivant (j'ai modifie des noms pour se rapprocher davantage de la realite):

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
Sub testCreateTable()
 
Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
Dim Sql As String, Cn As Object
Set Cn = CreateObject("Adodb.connection")
With Cn
                .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
        Sql = " select frm.* INTO [tableRealisation_RD] FROM [Data$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' "
        .Execute Sql
        .Close
    End With
    Set Cn = Nothing
End Sub
 
 
Sub test100()
 
' Chemin d'acces au fichier Access
Const Fichier = "C:\Users\a0h35300\Documents\Database1.accdb"
 
' Declarations des variables
Dim Sql As String, RsClub As Object, Cn As Object, Rs As Object, sh As Worksheet, nb As Long
Set Cn = CreateObject("Adodb.connection")
 
' Debut operation de transfert
With Cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
        .Open
       Set Rs = CreateObject("Adodb.recordset")
        Sql = "Select count(*)From [tableRealisation_RD]"
        Rs.Open Sql, Cn
        nb = Rs(0)
        Rs.Close
        Sql = "INSERT INTO [tableRealisation_RD] select frm.* FROM [Data$] as frm  in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' "
        .Execute Sql
         Set Rs = CreateObject("Adodb.recordset")
        Sql = "Select count(*)From [tableRealisation_RD]"
        Rs.Open Sql, Cn
        ' Demande autorisation pour vider le fichier Excel
        If MsgBox("Voulez-vous vider le fichier Excel", vbQuestion + vbYesNo, "Enregistrements Ajoutés(" & Rs(0) - nb & ")") = vbYes Then ThisWorkbook.Sheets("Data").Range("A2:D" & ThisWorkbook.Sheets("Data").UsedRange.Rows.Count).EntireRow.Delete
 
        Rs.Close
        .Close
    End With
    Set Cn = Nothing
 
End Sub

22/07/2016, 14h29
Invité

là je suis fort embêté car j'ai fait le même manip es j'ai pas de table d'erreur!
22/07/2016, 14h43
Borsec28

Ok j'ai compris !!
Ce sont les cellules vides qui me posent problemes en fait.

exemple : dans mon tableau un calcul se fait en automatique lors de la saisie (en fait un formulaire de saisie s'ouvre grace a des macros). Selon la couleur choisie au debut, le resultat se mettra dans la colonne A B ou C. Et lorsque la colonne est vide, ca me genere une ligne dans ma table d'erreur

Une solution pour ca ? Grace a une condition pendant le transfert genre _ si vide mettre un tiret ou un 0
22/07/2016, 14h55
Invité

Code:

Sql = "INSERT INTO [table test] select frm.* FROM [Feuil1$] as frm in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' where [EntêteNeColonne] is not null "

il faut que tu précise le nom du champ {EntêteNeColonne}!
22/07/2016, 15h07
Borsec28

Cet ajustement ne risque pas de me copier que les champs ou ma colonne n'est pas nulle ?
Je souhaite copier meme les vides car si c'est vide en A, c'est complete en B, et je veux aussi ces infos dans ma table
22/07/2016, 15h11
Invité

Code:

Sql = "INSERT INTO [table test] select frm.* FROM [Feuil1$] as frm in '" & ThisWorkbook.FullName & "' 'excel 8.0;HDR=Yes;IMEX=1;' where [A] is not null And [B] is not null And [C] is not null And [ETC] is not null"

si la ligne est vide alors pas importé!
22/07/2016, 15h37
Borsec28

C'est bon ca fonctionne !!!!! :D:D

Je ne me suis pas servi de cette derniere ligne mais j'ai bidouillé les formats de cellules et ca a fonctionné.
Merci infiniment rdurupt !!