Bonjour,
J'ai ce code qui fonctionne très bien (récupération partiel sur le net).
Mais je souhaiterais pouvoir :
- sélectionner plusieurs dossiers et non un seul
- que le code prenne les sous folders également

Merci pour votre aide


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
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
Dim fd As FileDialog
 
Dim vrtSelectedItem As Variant
'Définit le répertoire pour débuter la recherche de fichiers
SRC = vrtSelectedItem
 
'**********
 
'Declare a variable as a FileDialog object
 
 
 'Create a FileDialog object as a Folder Picker dialog box.
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 
 'Declare a variable to contain the path
 'of each selected item. Even though the path is aString,
 'the variable must be a Variant because For Each...Next
 'routines only work with Variants and Objects.
 
 'Use a With...End With block to reference the FileDialog object.
 With fd
 
 'Set the initial path to the C:\ drive.
 .InitialFileName = ""
 
 'Use the Show method to display the File Picker dialog box and return the user's action.
 'If the user presses the button...
 If .Show = -1 Then
 
 'Step through each string in the FileDialogSelectedItems collection.
 For Each vrtSelectedItem In .SelectedItems
 SRC = vrtSelectedItem & "\"
 Debug.Print SRC
 Next vrtSelectedItem
 
 'If the user presses Cancel...
 Else
 End If
 End With
 
 'Set the object variable to Nothing.
 Set fd = Nothing
 
 
    '************
    TABLE = "Loonkostgegeven"
    EXT = ".mdb"
 
    Set WK = ThisWorkbook
    Set WS = WK.Worksheets("Feuil1")
    DL = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
    Debug.Print DL
    With WS
        .Range("A2:AD" & DL).ClearContents
    End With
 
 
    FILE = Dir(SRC & "*" & EXT)
 
    While FILE <> ""
 
        Set DbExt = OpenDatabase(SRC & FILE)
        Application.StatusBar = "Import_" & FILE
        Debug.Print SRC & FILE
'        SQL = "select * from & NOM"
'        Set rs = DbExt.OpenRecordset(SQL, dbOpenSnapshot)
        Set rs = DbExt.OpenRecordset(TABLE, dbOpenTable)
        DL = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
        Debug.Print DL
        WS.Range("A" & DL).CopyFromRecordset rs
 
        Set rs = Nothing
        DbExt.Close
        Set DbExt = Nothing
        FILE = Dir
        Application.StatusBar = False
 
    Wend