Exporter donnees Excel dans Access VBA

**Borsec28** · 21/07/2016, 09h11

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 :

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
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 ?

Invité · 21/07/2016, 12h06

Bonjour,

Code :

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

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

**Borsec28** · 21/07/2016, 14h44

Merci beaucoup rdurupt, ca fonctionne tres bien !

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

Invité · 21/07/2016, 15h06

Vue que tu Exporte d'excel vers Access pourquoi ne pas le faire dans la foulé via Excel?

**Borsec28** · 21/07/2016, 15h10

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.

Invité · 21/07/2016, 15h49

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
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

**Borsec28** · 22/07/2016, 07h38

Merci encore

J'ai un probleme avec nb=Rs(0) avec comme message d'erreur "Variable not defined".
En quoi dois-je la declarer ?

Invité · 22/07/2016, 09h11

Bonjour,

Code :

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

Dim Sql As String, Cn As Object, Rs As Object, sh As Worksheet,nb as long

**Borsec28** · 22/07/2016, 12h55

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 ?

Merci pour la reponse

Invité · 22/07/2016, 13h28

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 Pour une seule fois :

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

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

**Borsec28** · 22/07/2016, 13h49

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 :

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

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

Invité · 22/07/2016, 14h04

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 :

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

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

**Borsec28** · 22/07/2016, 14h17

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 :

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
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

Invité · 22/07/2016, 14h29

là je suis fort embêté car j'ai fait le même manip es j'ai pas de table d'erreur!

**Borsec28** · 22/07/2016, 14h43

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

Invité · 22/07/2016, 14h55

Code :

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

 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}!

**Borsec28** · 22/07/2016, 15h07

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

Invité · 22/07/2016, 15h11

Code :

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

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é!

**Borsec28** · 22/07/2016, 15h37

C'est bon ca fonctionne !!!!!

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 !!

Exporter donnees Excel dans Access VBA [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager