importer excel dans table avec particularité

Version imprimable

Bonjour à tous

je souhaiterais importer un fichier Excel dans une table T_STAGIAIRES via mon formulaire F_GROUPES

1-ma table T_STAGIAIRES comprend les champs suivants:
GROUPE (en relation avec la table T_GROUPES); N° CIVILITE; NOM; NOM DE NAISSANCE; PRENOMS; DATE DE NAISSANCE; LIEU DE NAISSANCE; TEL; ADRESSE1; ADRESSE2; ADRESSE3

2-mon fichier excel que je vais chercher par le code suivant (que j'ai récupéré sur developpez.net) est composé des mêmes colonnes (sauf la colonne GROUPES qui est inexistant) et ce fichier contient également d'autres colonnes qui ne me servent pas dans Access.
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 Dim oApp As Excel.Application Dim oWkb As Excel.Workbook 'Dim oWSht As Excel.Worksheet Dim fDlg As Office.FileDialog, strFichier As String Set fDlg = Application.FileDialog(msoFileDialogOpen) fDlg.Filters.Clear fDlg.Filters.Add "Fichier Excel", "*.xl*" fDlg.InitialFileName = CurrentProject.Path & "\GROUPES" fDlg.InitialView = msoFileDialogViewList If fDlg.Show Then strFichier = fDlg.SelectedItems(1) End If Set fDlg = Nothing If Len(strFichier) = 0 Then Exit Sub Set oApp = CreateObject("excel.application") Set oWkb = oApp.Workbooks.Open(strFichier) '...code a mettre pour lancer l'importation"
Les particularités de cet importation:
- Celle-ci se fait sur mon formulaire F_GROUPES par un bouton BTN_IMPORT_STAGIAIRES
- Lors de l'importation je veux que dans ma première colonne de ma table (CHAMP GROUPES) s'inscrive automatiquement le nom du groupe sur lequel je suis.
L'importation se fait a partir de la ligne 3 et uniquement sur les colonnes nécessaires. (celles citées plus haut).

Merci par avance de votre aide en espérant avoir été limpide dans ma demande.

24/05/2016, 13h29
madefemere

Bonjour,

A mon avis, tu n'as pas choisi la meilleure façon de récupérer tes valeurs et de les ajouter dans ta table.
La meilleure façon d'importer des données à partir d'Excel vers Access est de les importer dans une table temporaire et de faire l'ajout dans la table définitive après.
1- Tu as la commande Docmd.TransfertSpreadSheet qui permet d'importer les données à partir d'une feuille Excel. L'aide te donnera tous les détails des arguments. Tu as ICI des explications sur la façon de limiter les données à importer.
2- Ensuite une requête INSERT te permettra d'ajouter les enregistrements voulus.

Cordialement.
24/05/2016, 23h41
Invité

Bonsoir,
Pour moi la meilleur importation reste encore une requête!
http://www.developpez.net/forums/d15...s/#post8637813
25/05/2016, 08h35
cjay974

Bonjour a tous

Merci à MADEFEMERE et RDURUPT pour vos réponses

Je me suis penché sur les deux solutions

Avec la commande Docmd.TransfertSpreadSheet elle a fonctionné une fois et après elle me plante mon ACCESS

Avec la requete cSQL = "INSERT INTO... j'ai une erreur 91 je vais essayé de revoir cela et je tiendrais le forum au courant.

Merci encore à ce site qui est très pro et pratique.

Cordialement

1 pièce(s) jointe(s)

Bonjour à tous

Je m'excuses du retard, j'étais très débordé.

J'ai essayé toutes les méthodes j'ai toujours des erreurs
1 ère erreur : Wend sans While alors que j'ai bien un While en ligne 46

Ci-dessous le code complet

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 
Private Sub BtnImportCdt_Click()
 
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim i As Long, strTrc As String
Dim db As DAO.Database, rsDest As DAO.Recordset
Dim fDlg As Office.FileDialog, strFichier As String
 
On Error GoTo ErrH:
 
' --------------------------
' Selection du fichier Excel
' --------------------------
Set fDlg = Application.FileDialog(msoFileDialogOpen)
' Définition du ou des filtres
fDlg.Filters.Clear
fDlg.Filters.Add "Fichier Excel", "*.xl*"
' Dossier de départ
fDlg.InitialFileName = CurrentProject.Path & "\GROUPES"
' Type d'affichage
fDlg.InitialView = msoFileDialogViewList
If fDlg.Show Then
   strFichier = fDlg.SelectedItems(1)
End If
Set fDlg = Nothing
' Si l'utilisateur a cliqué sur Annuler quitter la procédure
If Len(strFichier) = 0 Then Exit Sub
 
' --------------------------
' Ouverture du fichier Excel
' --------------------------
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(strFichier)   'Fichier sélectionné par l'utilisateur
'Set oWSht = oWkb.Worksheets("Feuil1") 'mettez ici le nom de la feuille qui contient les données à importer
 
' On ouvre un recordset sur la table dans laquelle on veut
' ajouter des enregistrements
Set db = CurrentDb
Set rsDest = db.OpenRecordset("T_IMPORT_TEMP", dbOpenDynaset)
'ligne du commencement importation
i = 3
 
'Tant que la colonne 1 (A) n'est pas vide
While Len(oWSht.Cells(i, 1).Text) > 0
 
    'condition de remplissage de la table => eviter les doublons
    'si l'enregistrement existe déjà dans la table destination,
    'on passe à la ligne suivante sans l'importer
    If DCount("*", "[T_IMPORT_TEMP]", "[N°] = " & oWSht.Cells(i, 1)) = 0 Then
    'MsgBox "verifie si pas doublon ok"
    'le numéro 1 correspond au numéro de la colonne source, tel que : A=1, B=2, C=3 ...
       rsDest.AddNew
       strTrc = "[N°]"
         rsDest("N°") = oWSht.Cells(i, 1)
         MsgBox "ajout N° ok"
       strTrc = "[CIVILITE]"
         rsDest("CIVILITE") = oWSht.Cells(i, 2)
       strTrc = "[NOM]"
         rsDest("NOM") = oWSht.Cells(i, 3)
       strTrc = "[NOM DE JEUNE FILLE]"
         rsDest("NOM DE JEUNE FILLE") = oWSht.Cells(i, 4)
       strTrc = "[PRENOMS]"
         rsDest("PRENOMS") = oWSht.Cells(i, 5)
       strTrc = "[DATE DE NAISSANCE]"
         rsDest("DATE DE NAISSANCE") = oWSht.Cells(i, 6)
       strTrc = "[LIEU DE NAISSANCE]"
         rsDest("LIEU DE NAISSANCE") = oWSht.Cells(i, 7)
       strTrc = "[TEL]"
         rsDest("TEL") = oWSht.Cells(i, 8)
       strTrc = "[ADRESSE1]"
         rsDest("ADRESSE1") = oWSht.Cells(i, 9)
       strTrc = "[ADRESSE2]"
         rsDest("ADRESSE2") = oWSht.Cells(i, 10)
       strTrc = "[ADRESSE3]"
         rsDest("ADRESSE3") = oWSht.Cells(i, 11)
       strTrc = "Sauver Nouvel Enregistrement"
       rsDest.Update
    'End If
    strTrc = ""
    'on incrémente la variable i pour passer à la ligne suivante
    i = i + 1
Wend
 
Sortie:
Set oWSht = Nothing
If Not (oWkb Is Nothing) Then oWkb.Close False
Set oWkb = Nothing
If Not (oApp Is Nothing) Then oApp.Quit
Set oApp = Nothing
If Not (rsDest Is Nothing) Then rsDest.Close
Exit Sub
 
ErrH:
Select Case Err.Number
    Case 3022 ' Risque de doublon - Violation Clé/Index unique
         ' on annule l'ajout et on continue
         rsDest.CancelUpdate
         Resume Next
    ' Erreur ignorées. Pour les prendre en compte, mettre en commentaire
    ' l'instruction Resume Next
    Case 3163 ' Le champ est trop petit pour accepter la quantité de données que vous voulez ajouter
         Resume Next
    Case 3349 ' Dépassement de capacité sur un champ numérique
         Resume Next
    Case 3421 ' Erreur de conversion de type
         Resume Next
End Select
 
MsgBox "Erreur No. " & Err.Number & " : " & Err.Description, , _
       "Ligne " & i & ". " & strTrc
Resume Sortie
 
End Sub

je vous joint le modèle de fichier excel que je ne peux pas modifié car utilisé par nos clients en l'état (j'ai bien sure modifié les noms, prénoms, tel... par soucis de confidentialité)

Pour info j'utilise Access 2003 et office 2013

Merci d'avance

Bonjour,

Code:

1
2
3
4
5
6
7
Sub test()
On Error Resume Next
CurrentDb.Execute "Drop table toto;"
On Error GoTo 0
cSQL = "SELECT [Sheet1$A2:P1048576].* AS [Sheet1$A2] INTO toto FROM [Sheet1$A2:P1048576] IN 'C:\Users\rdurupt\Downloads\G10 Informatique je débute.xlsx'[excel 8.0;HDR=Yes;IMEX=1;];"
CurrentDb.Execute cSQL
End Sub

Bonjour à tous

Merci beaucoup pour votre aide cela marche nickel

ci-dessous le code complet pour ceux que ça interresse

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
 
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim i As Long, strTrc As String
Dim db As DAO.Database, rsDest As DAO.Recordset
Dim fDlg As Office.FileDialog, strFichier As String
 
' --------------------------
' Selection du fichier Excel
' --------------------------
Set fDlg = Application.FileDialog(msoFileDialogOpen)
' Définition du ou des filtres
fDlg.Filters.Clear
fDlg.Filters.Add "Fichier Excel", "*.xl*;*.ods"
' Dossier de départ
fDlg.InitialFileName = CurrentProject.Path & "\GROUPES"
' Type d'affichage
fDlg.InitialView = msoFileDialogViewList
If fDlg.Show Then
   strFichier = fDlg.SelectedItems(1)
'Extraction du nom du fichier à copier.
        strFichier = Mid(fDlg.SelectedItems(1), InStrRev(fDlg.SelectedItems(1), "\"))
        'Chargement de l'image (sous dossier base).
        Me.FICHIER_GROUPE = strFichier
End If
Set fDlg = Nothing
' Si l'utilisateur a cliqué sur Annuler quitter la procédure
If Len(strFichier) = 0 Then Exit Sub
 
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(CurrentProject.Path & "\GROUPES" & Me.FICHIER_GROUPE)
Set oWSht = oWkb.Worksheets("Sheet1")
'premier ligne ou tu commence ton import
i = 3
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant que la cellule n'est pas vide
While oWSht.Cells(i, 1).Value <> ""
 
  cSQL = "insert into [T_IMPORT_TEMP] ( [N°], [CIVILITE], [NOM], [NOM JEUNE FILLE], [PRENOMS], [DATE DE NAISSANCE], [LIEU DE NAISSANCE], [TEL], [ADRESSE1], [ADRESSE2], [ADRESSE3] ) values (" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 9) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 11) & Chr(34) & ")"
 
'exécute la requète
  DoCmd.RunSQL cSQL
 
i = i + 1
Wend
MsgBox "importation terminée"
DoCmd.SetWarnings True
 
Sortie:
Set oWSht = Nothing
If Not (oWkb Is Nothing) Then oWkb.Close False
Set oWkb = Nothing
If Not (oApp Is Nothing) Then oApp.Quit
Set oApp = Nothing
If Not (rsDest Is Nothing) Then rsDest.Close
Exit Sub
 
Resume Sortie

Merci encore à tous vous êtes super:applo:

Bonne continuation