Discussion :

[ghammouzi]

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.

[Zekraoui_Jakani]

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

[ghammouzi]

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"

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

et merci

[Zekraoui_Jakani]

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

[ghammouzi]

Merci pour votre aide, c'est gentil de votre part, ça bien marché merci encore.