Bonjour
J'ai une base de données ACCESS et plusieurs classeurs EXCEL de la même forme, quel code VBA à utiliser pour les importer tous à la même fois.
Et merci.
Bonjour
J'ai une base de données ACCESS et plusieurs classeurs EXCEL de la même forme, quel code VBA à utiliser pour les importer tous à la même fois.
Et merci.
Ecrivez le code pour un seul fichier, puis insérez ce code dans une boucle couvrant tous les fichiers concernés.
Exemple:
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 Sub ImporterLesfichiersXL() Dim fileName As Variant Dim j As Long: j = 1 Dim Dest fileName = Dir("C:\Users\Ghammouzi\Documents\") 'Ligne à adapter While fileName <> "" 'En supposant que les noms de vos fichiers commencent toujours par "Book" (sinon s'assurer qu'ils ont une partie commune à exploiter) If fileName Like "*Book*" Then Dest = "Table" & j 'Nom de la table de destination DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, (Dest), "C:\Users\Ghammouzi\Documents\" & fileName, True 'Ligne ci-dessus à adapter j = j + 1 End If fileName = Dir Wend End Sub
Bonjour,
Ou mettre la boucle de choix de tous les classeurs sélectionnés dans "listfiles1" de ce code pour que Access puisse importer tous les classeurs selectionnés dans la table nommée "Table_1"
et merci
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 Private Sub cmdImportJ_Click() On Error Resume Next CurrentDb.Execute "DELETE Table_1.* FROM Table_1" If listfiles1.ListCount < 1 Then MsgBox "Choisis les fichiers " Exit Sub End If Dim I As Long Dim j As Long Dim m As Long Dim Eleve As Recordset Set Eleve = CurrentDb.OpenRecordset("Table_1") Set appExcel = CreateObject("Excel.Application") For m = 0 To listfiles1.ListCount - 1 Set wbExcel = appExcel.Workbooks.Open(listfiles1.ItemData(m)) For j = 1 To wbExcel.Worksheets.Count Set wsExcel = wbExcel.Worksheets(j) wsExcel.Activate For I = 14 To 2222 DoEvents Eleve.AddNew If wsExcel.Application.Cells(I, 1) <> "" Then Eleve("nuemer") = wsExcel.Application.Cells(I, 4) Eleve("jury") = wsExcel.Application.Cells(I, 3) Eleve("serie") = wsExcel.Application.Cells(9, 3) Eleve.Update End If Next Next Next MsgBox "Opération terminée avec succès!!!" DoCmd.OpenQuery "R_Genre_Aff_Jury" wbExcel.Close Workbooks.Close appExcel.Quit End Sub
L'approche est tout à fait différente:
Dans l'exemple que je vous ai fourni, la liste des fichiers à importer est reprise sous un répertoire de votre choix.
Ces fichiers sont entièrement importés dans des tables distinctes.
Dans votre cas, vous vous basez sur une liste de fichiers présélectionnés (listfiles1).
Vous effectuez une lecture séquentielle sur toutes les feuilles de chaque fichier, pour en extraire 3 informations à écrire dans une même table (Table_1), pour plus de 2200 élèves.
Le code que avez publié doit parfaitement répondre à ce que vous cherchiez; je ne comprends dès lors pas pourquoi vous cherchez une solution que vous avez déjà ! Avez-vous bien exprimé ce que vous voulez ?!
Voici votre code restructuré:
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 Sub cmdImportJ_Click() On Error Resume Next CurrentDb.Execute "DELETE Table_1.* FROM Table_1" If listfiles1.ListCount < 1 Then MsgBox "Choisis les fichiers " Exit Sub End If Dim I As Long Dim j As Long Dim m As Long Dim Eleve As Recordset Dim appExcel As Object Set Eleve = CurrentDb.OpenRecordset("Table_1") Set appExcel = CreateObject("Excel.Application") For m = 0 To listfiles1.ListCount - 1 Set wbExcel = appExcel.Workbooks.Open(listfiles1.ItemData(m)) For j = 1 To wbExcel.Worksheets.Count Set wsExcel = wbExcel.Worksheets(j) wsExcel.Activate For I = 14 To 2222 DoEvents Eleve.AddNew If wsExcel.Application.Cells(I, 1) <> "" Then Eleve("nuemer") = wsExcel.Application.Cells(I, 4) Eleve("jury") = wsExcel.Application.Cells(I, 3) Eleve("serie") = wsExcel.Application.Cells(9, 3) Eleve.Update End If Next I Next j Next m MsgBox "Opération terminée avec succès!!!" DoCmd.OpenQuery "R_Genre_Aff_Jury" wbExcel.Close Workbooks.Close appExcel.Quit End Sub
Merci pour votre aide, c'est gentil de votre part, ça bien marché merci encore.
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager