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